perm filename PARSE.SAI[AL,HE]15 blob
sn#372605 filedate 1978-08-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00052 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 UPDATES TO PARSE BY MSM
C00010 00003 the AL to S-expression translator AND MSM SWITCHES
C00015 00004 ! statement, operator, sex, require, move definitions
C00021 00005 ! brace, condition_monitor, dimension, misc reserved word definitions
C00023 00006 ! dec_name, declaration names for input and output
C00025 00007 ! operators
C00027 00008 ! reserved_words
C00030 00009 ! init_reserved
C00032 00010 ! predefined constants
C00035 00011 ! predefined macros
C00037 00012 ! compiler switches and control tables
C00040 00013 ! hash, declaration of debugging variables, start of hidden_parse
C00043 00014 ! ---- DECLARATIONS ----
C00049 00015 ! record declarations
C00055 00016 ! other declarations
C00057 00017 ! error, error_recovery, error_reject, print, file_indent
C00073 00018 ! process_switches, got_input, got_output, open_logging_file, open_new_file,check_want_copy
C00081 00019 ! push_source_list,pop_source_list,new_expr_rec
C00083 00020 ! id info processing routines
C00089 00021 ! read
C00094 00022 ! macro handling routine
C00100 00023 ! expand_macro
C00105 00024 ! get_token
C00118 00025
C00122 00026 ! check, inverse, multiply and divide dimensions ! CHECK_EXP_TYPE_DIMENS
C00127 00027 ! check_entry,insert_entry into tables
C00133 00028 ! expression evaluation routines
C00146 00029 ! P_EXP2_BASIC, OPCODE, ERROR HANDLER
C00151 00030 ! exp,bfact,bterm,aexp,term,factor
C00173 00031 ! exp2 starts here, p_exp_basic
C00174 00032 ! P_condition
C00184 00033 ! P_clauses, T_gen
C00198 00034 ! P_statement, F_state, modify_continue, modify_flush
C00203 00035 ! begin_P,end_P, open_paren_P
C00213 00036 ! for_P,case_P,do_P
C00219 00037 ! move_P,affix_P,unfix_P
C00226 00038 ! signal_p, wait_p
C00230 00039 ! dump_P
C00234 00040 ! on_P, reference_P,deproach_P
C00237 00041 ! open_P,center_P,stop_P,enable_P,disable_P
C00240 00042 ! require_P
C00247 00043 ! dimension_P
C00250 00044 ! string_P
C00252 00045 ! abort_P, note_P,comment_P,speed_factor_P,wrist_P,setbase_P
C00256 00046 ! define_P,declare_P,global_P,procedure_P,return_P
C00271 00047 ! P_statement execution starts here
C00282 00048 ! execution starts here, initialization
C00287 00049 ! set up input and output
C00291 00050 ! set up predefined dimensions, constants, macros and variables
C00294 00051 ! PARSE PROGRAM
C00296 00052 ! SWAP TO AL COMPILER
C00298 ENDMK
C⊗;
COMMENT UPDATES TO PARSE BY MSM
8- 4-78 no more I option on error
unused variables now give warning message
7-26-78 no more user comment delimiters and macro delimiters
7-13-78 WRIST,SETFORCE
6-27-78 INT DIV MOD ETC
6- 3-78 IMPLEMENTED ARRAY, PROCEDURE DECLARATIONS AND RELEVANT UPDATE TO
EXP,BFACT, case statement
DO .... UNTIL STATEMENT
5-30-78 IMPLEMENTED DEPROACH(F)←T
5-29-78 IMPLEMENTED LOG,EXP,CONSTRUCT,≡
CASE STATEMENT
5 -15-78 FIXED BUG IN CHECK_DIMENSIONS WHICH CAUSED A RECORD WITH
ALL COEFFICIENTS NON ZERO TO BE NOT TREATED AS NIL_DIMENS
COMPILER SWITCH "N" AND UNKNOWN SWITCH PASSED THROUGH AT ARG'S REQUEST
3 - 7-78 UNIQUE S-EXPRESSION IDENTIFIERS BEGINNING WITH $
3 - 4-78 EXPRESSION PARSER CHANGED, ADDED SIN, COS, ACOS, ASIN, etc
11-24-77 NONRIGIDLY DEFAULT AFFIXMENT CHANGED TO RIGIDLY
NO NULL ADDED
9-15-77 FIXED BUG THAT MAKES INV(A)*B TO (TINVRT (TTMUL A B))
BY ADDING "INV" TO PARSE_SPECIAL
6-29-77 GLOBAL BACKUP TO END OF LATEST END,BEGIN OR SEMI-COLON POSSIBLE
6- 7-77 PREDEFINED MACROS
ADJACENT MACRO BUG FIXED
6- 1-77 CODE FOR NEW FORCE STUFF
5-19-77 UNARY + AND - FINALLY WORK, SIGH
5- 3-77 STRICT DIMENSIONAL CHECKING NOW DEFAULT
3-16-77 ENABLE/DISABLE
MESSAGE END OF EACH BLOCK GIVING LIST OF VARIABLES NOT DEFINED AND
NOT USED
REMOVED PARSESHIT
1- 9-77 MORE MEANINGFUL ERROR MESSAGES
1- 9-77 CAN CORRECT MORE ERRORS
WILL NOT ACCEPT DIMENSIONS ON ANYTHING EXCEPT SCALARS AND VECTORS.
1- 5-77 ACCEPTS STRING DEFINITIONS
12-25-76 CAN CORRECT MINOR ERRORS IN SOURCE CODE IN_LINE
12-23-76 CAN ACCEPT TTY INPUT AS A FILE
12-21-76 ACCEPTS DIMENSIONS ON CONDITAON MONITORS
CREATES NEW DECLARATIONS IF UNDECLARED TERM USED IN LHS OF ASSIGNMENT
12-15-76 BAIL CAN BE CALLED IN FROM REQUIRE SWITCHES INSTRUCTIONS
DEFAULT AND ONLY ACCEPTABLE DAMENSAONS OF FRAME IS DISTANCE
TRANS SHOULD BE DIMENSIONLESS
12-14-76 NEW SETUP FOR RESERVAD WORD DEFINITIONS, ETC.
ERROR RECOV@ %2jjXA]⊃ ≤A→∪→
A¬'↔ λ↓
∨$A⊃∨ &A9∨(A a∪'(~(∩∪π∨5¬∪≥βQ∪∨≤A= A!→U&1$Y5∪≥+&a$~∀∩%π∨≠¬%≥β)∪=≤A∨ ↓)≠β↔∀1$XA→≠β↔
a$~∀bHZb`Z\l∪/⊃∃≤A %I∨$A∨_A≠βπI≡A/∪Q⊂A!βIβ≠ )∃%&Aβ
)+β_↓!β%β5 ) %LA'+¬M)∪)+Q λ~∀$∪βππ∃!)&A=≥→2A⊃∪')β9π
A-∃π)∨$↓ )εA9≡A ∨9∂ $AY π)∨HA ∪'Qβ≥π
4∀∩∪%∃#+∪%∀A¬β∪0Aβ ∃λ~∀bHZ@nZ\l∪≠β
%≡A a!β≥'%∨∀A∨_A) 1PA∨,hQEI5β15]XM∩⊗FVM∩∃α∞|j6⊗:!B∩⊗2Lj&R⊗∃_4)E
iEY5;0&:⊗:α∞"⊗≤Xb⊗:%∩eαεt!α&:≤*JPb,rRJe¬αJ>∞,"VJ⊗_h)EEk U5]0J&:N-∩R&>rα>→α≥"J&∞!B∩&6,pb∞",~-αN<JR∞ hP$&εdaαBJ,"⊗~&t*⊃α∞|rNRεu"Mα∩,~2εJ,!α∩&l*:Nε|r2⊗N_h)EEk Q5]0J∩&6,rN&>tb⊗NM∧"⊗∞∩
∩εRε|qα∞>-∩∞⊗⊃¬"=αRMα∃α≡2α⊗bB∀*NN&|p4($MB"εQeJ"εQeR"εQ∧jε∩∃∧"&6⊗u~&>:d*NL4S E5Yk9X$&t*]α↑
Iα>→∧~>&B-"&:≥∧"&6⊗u~&>:_h)EEk⊃5]XHJ∞"εt:∃α2 ∩⊗1α$yαNRlbε α|qαB≥β04)E
iI5]0H&∞" r≡⊗M¬"=α∩,~2εJ)BAαRzβπ33␈9β∪↔6 W3Qε{→β∪O≠Sπ;≡)βS=ε3Kπ7/_4)E
iI5]0H&29#IαB≥β⊃Qαε$"⊗⊃α$yα≡&4)α∩&l*:Nε|qα>→∧2Jε6*αεMα$JNRεt~∀4) 5I5;0$&ε$"⊗⊃α,bN∃α$J6⎇A∧
~R⊗∩αN⊗∞|r⊃α&2αNRε$*6⊗:"αR=α≥*J¬α∃*≥α>rαB≥↓# α∩⊗≤bεJ∀E4)E
iE5]0H&↑>∀∩2¬α≤z66εt!α&6∧b⊗&⊗u"⊗⊂4S A5IJi]Xεdz≡≡&t9α~⊗
"VJ∃∧J6B∩,j⊗:R, 4)EαiI]5;0&RZ≥* αεt!αZN,⊃α&6∧b⊗&⊗u"⊗⊂4S A5EBi]Xε≤Bε:≡*αNR>αα
2V*α>IαL*22>:αR=α≥">Aα∀
J5α⎇⊃αfε∀il4(hP3∂?nk↔;Q∧εFF*λ→Bπ&t
2n/∞
&/∨=≥vrπN,⊗w≡L≡F␈∩λ→d"∧X9R¬≥y~D≤DZ70hPQ(&.>≥dα*⊂4ThTA"C!*Q05)~Q( Fε∞λ∀jJR3Qc
⊃∪∞d∧∀Q4*Y4Q(ε&
∞⊂∀h∧RING_SPACE; REQUIR@
@dβ↓Qaα≥JNR⊗iBBα⊃Xh+K↔∂+'K∃α∩nvNh∧"ε&]H
-]=→4N]FEεB∧DDDY2s4w→FE↓∧Omq2cZw(
,
λ∧ε∩{mK]I:α`4)∧Kjg∂?nk↔;Rh¬@hWL≤ Kjv⊂ %AαA0v≥∧↑S@14εbX~)YL∩z≤bdX~)ML∩z≤bh@0hS∂H%j9EU0hSGCπ≤∧PKjvBα`HαY≤.]⎇→"'Tm @⊗βE9xz[z2D↑IX∧7,
rubout =≤b`≥]`h ⊗∨-H A↔4j↓f⊗αS∪@12)P~X4⊃C@7∧∧W.x;Y↓↔)m≠ ∧¬∃S⊂1QCgαC↔H%k→I04T CKπβ∪εF∂= WKβ( ≠ ∧@
`!β∪?∂↔'+K∀cF @≡F↑ ∂&⊗Kβ"M\8|[c
_<p∀→y∧↑@14∧X~∃5KieSα_c#π≤¬ε/⊂↔P &@⊗εE 2eserve`⊂⊃Q¬`∂#↔RD_CLASS],
preload_array(name, defs, type, first, len)=[
preset_with defs null; type array name[first:first+len] ];
! N.B. -- preload_array always creates an array 1 longer than requested;
! if /nB is set in the command line then assume he wants a debugging parser;
define id_type_table=0,
macro_type_table = 1,
macro_in_macro_type_table = 2,
dimension_type_table = 3 ,
array_type_table = 4,
procedure_type_table = 5;
require "<><>" delimiters;
ifc ¬declaration(debug_compile) thenc
define
decipher_debug(a)=<
assignc a=cvms(compiler!banner)[2 to ∞-1];
assignc a=cvps(a)[length(scanc(cvps(a), lf, null, "IA"))+1 for ∞];
assignc a=cvps(a)[length(scanc(cvps(a), tab, null, "IA"))+1 for ∞];
assignc a=cvps(a)[length(scanc(cvps(a), space, null, "IA"))+1 for 1];
"a">;
ifc decipher_debug()="0"
thenc define debug_compile=false;
elsec define debug_compile=true;
endc
endc
define
decipher_compiletime(a)=<
assignc a=cvms(compiler!banner)[2 to ∞-1];
assignc a=cvps(a)[length(scanc(cvps(a), tab, null, "IA"))+6 for 21];
"a">;
require unstack_delimiters;
require ifc ¬debug_compile
thenc " NON-" elsec " " endc & "DEBUGGING VERSION " message;
ifc debug_compile thenc EXTERNAL PROCEDURE BAIL;
REQUIRE "LA" ERROR_MODES; ! to compile and go home when system busy;
endc
define
indices(name, postfix)=[
redefine xxcount=0;
redefine xx(xxarg)=[
redefine xxtemp=[define xxarg] & [postfix=xxcount];
xxtemp;
redefine xxcount=xxcount+1;];
name];
! ID postfix conventions
_VALUE AL data types
_RES reserved word types
_beg reserved word group begin
_end reserved word group end
_R REDUCE action routines
_P PARSE action routines
_TOKEN scanner token types
_CM condition monitors
_X indices of various sorts
_METRIC dimensional analysis non-sense
_DIMEN how to combine various matrix operands
_TYPE to decide which table to insert into
;
! **********; require "SNAILR[AL,HE]" source_file; ! **********;
INTEGER PROCEDURE ___TIME;
BEGIN
INTEGER __T;
quick_code
setz '13, ;
calli '13,'27 ;
movem '13,__T ;
end;
RETURN(__T);
END;
! ************ MSM SWITCHES *************;
DEFINE DEFIN_PRINT_SWITCH = FALSE;
DEFINE DUP_FILE = true;
DEFINE full_set = true;
! statement, operator, sex, require, move definitions;
redefine xx(str)=[
redefine reserved_X_count=reserved_X_count+1;
redefine xx_temp="define " & "str" & "_RES=reserved_X_count";
xx_temp;];
redefine yy(str,str2)=[];
redefine zz(str)=[
redefine reserved_X_count=reserved_X_count+1;
redefine zz_temp="define " & "str" & "_RES=reserved_X_count";
zz_temp;];
define statement_definitions=[
xx(BEGIN)
yy(COBEGIN)
xx(END)
yy(COEND)
yy([;])
zz(OPEN_PAREN)
yy([(])
zz(DECLARE)
yy(SCALAR, scalar_value)
yy(VECTOR, vector_value)
yy(ROT, rot_value)
yy(FRAME, frame_value)
yy(PLANE, plane_value)
yy(TRANS, trans_value)
yy(EVENT, event_value)
yy(ATOM, atom_value)
yy(WORLD, world_value)
yy(LABEL, label_value)
! xx(GLOBAL) ;
xx(IF)
xx(PLAN)
xx(WHILE)
xx(FOR)
xx(DO)
xx(CASE)
Xx(RETURN)
xx(MOVE)
xx(AFFIX)
xx(UNFIX)
xx(SIGNAL)
xx(GAIT!
! xx(WHEN) ;
xx(DUMP)
! xx(ASSERT)
α yy(DENY) ;
xx(ON)
yy(DEFER)
!xx(REFERENCE) ;
xx(OPEN)
yy(CLOSE)
xx(CENTER)
xx(STOP)
xx(SPEED_FACTOR)
xx(DEPROACH)
xx(PROCEDURE)
xx(DEFIJE)
xx(REQUIRE)
@apQ ∪5 ≥'∪=≤R~∀∧∪qpQM)%∪≥≤R~∀∩AsrQ9 .1'Q%∪≥∞$~∀∩@↓srQ∨1λ1')I∪≥∞Rv~∃q`Qπ∨≠5 ≥(R4∃qpQ¬¬∨%($~∀@AerQ!%%≥(R~(@Asr!!β+'∀R~∧@↓srQ!I∨≠!($~∃qp!≥∨)
$~∀@AerQ≥∨Q
bR~(@Asr!≥∨)
HR~∃q`Q' β'
R4∃qpQ]%∪'($~∃qp! ∃β¬1
R~∃apQ ∪Mβ¬→
$~∃:v4∀~∃I∃MS]J↓←aKe¬i←d1
YCgg∃f{6~)utQπ=≠≠αR4∀@AsdQ6Y:$~∃qp! #,X%Kcl1`R~)αβge"Yru0'- XbaHh+caDzI0'␈⊂ba$hQ↓βgJBl}u`K?HbBH4)↓πKe"l5i0'c␈⊂ba$hQ↓βgJBb>I`Kc?HEA$4+GA"ε: `'π≠!Ba$4R↓βgeEX∩u0N ;⊂b@H4+cBB:>Q`K;?PEA$4)αβge"X*u0'v{PbaHh+kiDzJ∩⊗⊂H4)↓πKe"mmi0'O-λba$hQ↓βgJBlnu`KO;∀EA$4 αβge"[ru0'≡;PbaHh)↓βOI"mrj`'O3!Ba$4R↓βgeEXvu0O≠∨∀bBH4)↓πKe"lei0'Of(ba$hSki" ∩M$4R↓βgeE[ru0O≠π LEA$4)
βge"52ZRJ rM%LhSki" "⊃$4R↓βgeEY.u0Oβ3WLEA$4 αβge"Zju0'nK;WLEA$4+UQ"6Ve!$4 αβge"Zru0'6#?Pb@H4)↓πKe"mUi0'SNk↔LbBH4)↓πKe"m⎇i0'O&KXbaHh)↓βOI"6ε@`'7πACa$∀R↓βgeDj&90Nk'8cBH4)↓πKe"∩M10'∪O0ca∧hQ↓βgJB6>⊃`K7?⊂EA$4 λβge"52J>Q`K[@7-}AEB∀π0hW/%¬=∃E⊃PRα∂∨∩E=*A@O?.C¬BHQ$απO∃β∩`H∪∪¬BHQ$απO∃ 5ujA≡7&␈3 αHh/+"D5Yh2Hh$⊂πOJ 45jbA≥f}oc αKXQ$απO∃ u∀LYjB`N}-⊗.wA αHhαHλ∂∨*∃3I~ α=.l8⎇ε ¬!"H∧∂>*⊂+ 4kα,∨~8 L⊗∀FE⊂λ<|T(∪iV∧x≠yL,∀CE⊂⊂<↑T$g+ ∧y4w≥ ,∀FB⊂⊂<|J$g*⊗αtw: ⊗∀FE⊂λ<|T!Se)j)∃aj⊗∧Xww9z≤:qz ⊗∀FE⊂λ<|T)Ti*⊗∧\xy2 ≡∀FE⊂λ<|T)Rg⊗∧yZw <∀CE⊂⊂<↑T!giK∧qwyF<⊂FEλ⊂<|T⊂idg, asin_x!
yy(ACOS, acos_x!
yy(ATAN∩, atan2_x)
yy(DOG, log_x!
yy(EXP, exp_X)
α! zz(SCALAR)
yy(ANGLE, angle_X);
zz(CLOSE_PAREN)
α yy([)])
];
define requIre_definiTions=[
xx(SOURCE_FILE)
xx(MESSAGE)
xx(ERROR_MODES)
xx(COMPILER_SGITCHES)
xx(BAIL)
];
define move_definitions=[
xx(VIA)
xx(WITH)
xx(APPROACH)
yy(ARRIVAL)
yy(DEPARTURE)
Xx(WOBBLE)
xx(NO_NULLING
xx(NULLING)
xx(DIRECTLY)
];
! AlL resErved wordclas@LASHOLAQCmα)β¬β∧{OS≠MAβ?→α⊂bJ⊗~⊃9↓α&C∃β≠∞≠QβSF QβSF)βCπ↔≠↔H4R↓β∨K␈+CMβ≡cπO↔~βS/∨/##↔IεK@~π,\ff.>LV"ε/∀π&FT F.6≥m↔&N⎇`ε}∩
≤B?~∞⎇↔&B∧#ε⊗.t$ε∞vAQ"αα# Vv"$∞ε␈∨Lm↔F/5dα¬& Tε≡}LTε&.\≥f'~∞Mε∂"
]↔≡→
(U~ε,TββXQ!PPH⊃⊃⊂HH⊃⊃⊗&.m≥f(h.8 /β∀Q4a⊃/+$EA"X\L≤y&∀HZb/+&∃β"[-≡xf∀HZb/,¬A"X{#
Q4b!↔, β!.Y<q..Y9ε β_{⎇-n∂, ↓QC"\nL=→;,]]ε_L\b/<L↑y<]L\ε⊗ε =⎇;]¬6.c"A⊃""".>_=→-\;]ε L9Z;M≡~;{N7c"B!⊃"""!⊃"9→,m;Y#!.⎇_= ]9;]β 9Yα'↑Y<p∩\;2r ⊗ 1wz[:⊗εE≠x2y0]7y 1→sD↑y→yry;→r , _wzw:
X]FEαDDDD[x2y0]7y 1[0yyb\]FE∧BDDDDBDDr2Y4w2FB7x2y_z7y →w2∧↑\2yr`2ved_X_count,
move_beg =reserved_X_count+13
move_definitions;
define
mov@∀1K@; IwK↔≤∧W↔⊗\C¬AF=}Vw"AQ'⊗/≡X
.,&_Y,q/<Y.<αy;"Y , 1[zw:∃L]FE∧BDDDy→xzty→L22s~w4z4[w9]FB∧DDDBDDDDY2s4w→FA92\zpy2F2s2∧Oy2yb\;2r ⊗ 1wz[:∃X]CE∧DDBDl,∀∪bj)$PTDP@∃$fbVλ"$ij⊂e!bVλ2z1W∞FEεE~w24`#es(require_definitions$ _X);
indi@
KfQ[=mJ1I∃MS]Sβ#'?;~abaKX4( ! brace, condition_monitor, dimension, misc reserved word definitions;
define brace_definitions=[
zz(BRACE)
yy([}])
yy([{])
];
define cm_definitions=[
zz(cm)
qq(nil)
yy(FORCE, force_cm)
yy(TORQUE, torque_cm)
yy(DURATION, duration_cm)
yy(TEMPERATURE)
yy(SQUEEZE)
];
define metric_definitions=[
zz(METRIC)
qq(nil)
yy(DISTANCE, distance_METRIC)
yy(TIME, time_METRIC)
! yy(MASS, mass_METRIC) ;
yy(ANGLE, angle_METRIC)
yy(FORCE, force_metric)
];
DEFINE MISC_DEFINITIONS=[
zz(MISC)
yy([?])
yy(ABS)
yy(TO)
yy(TRACING)
yy(WHERE)
yy(THEN)
yy(FORM)
yy(AT)
yy(BY)
yy(CHANGING)
yy(ALSO)
yy(DONT)
yy(ONLY)
yy(QUERY)
yy(RIGIDLY)
yy(NONRIGIDLY)
yy(STEP)
yy(INSCALAR)
yy(UNTIL)
yy(ELSE)
! yy(⊗) ;
];
redefine zz(str)=[];
redefine qq(str)=[
redefine qq_temp=[xx(str)];
qq_temp;];
redefine yy(str,str2)=[
redefine yy_temp=[xx(str)];
yy_temp;];
indices(metric_definitions, _METRIC);
define
metric_max =xxcount-1;
indices(cm_definitions, _CM);
EVALdefine basic_dimensions=[
redefine zz(str,str2)=[];
redefine qq(str,str2)=[];
redefine yy(str,str2)=[xx(str)];
metric_definitions
];
! dec_name, declaration names for input and output;
! don't juggle the order of these definitions, because the parse will cease to
function;
define dec_name_definitions=[
xx(SCALAR, $SVAR)
xx(VECTOR, $VVAR)
xx(ROT, $RVAR)
xx(FRAME, $FVAR)
xx(PLANE, $PVAR)
xx(TRANS, $TVAR)
xx(EVENT, $EVAR)
xx(ATOM, $ATOM)
xx(WORLD, $WVAR)
! xx(CM_LABEL, $OMNLAB)
xx(CLC_LABEL, $CLCLAB)
xx(CH_LABEL, $CHGLAB)
xx(LABEL, $STMLAB) ;
xx(LABEL, $LAB)
];
! data types;
DEFINE
string_VALUE =-2,
form_VALUE =-1,
boole_VALUE =0; ! others follow directly, but see later;
define
dec_name_count=0;
redefine xx(in, out)=[
redefine dec_name_count=dec_name_count+1;
redefine xx_temp="define in" & "_VALUE=" & cvms(dec_name_count);
xx_temp;];
dec_name_definitions;
redefine boole_value=scalar_value;
define frame_exp_VALUE=trans_VALUE; ! COERCION DICTATES THAT THESE BE THE SAME;
redefine xx(in, out)=["out",];
preload_array(
dec_name, dec_name_definitions, string, 1, dec_name_count);
! operators;
define operator_definitions=[
XX(NOT)
XX(EQV)
XX(AND)
XX(OR)
XX(XOR)
XX(SEQ)
XX(SNE)
XX(SGT)
XX(SLT)
XX(SGE)
XX(SLE)
XX(UVECT)
XX(AXIS)
XX(POS)
XX(ORIENT)
XX(TMAKE)
XX(VMAKE)
XX(FMAKE)
XX(VVTRANS)
! XX(SNEG) ;
XX(RINV)
XX(SABS)
XX([+], PLUS)
XX([-], MINUS)
XX([*], TIMES)
XX(MAX)
XX(MIN)
XX(DIV)
XX(MOD)
XX(INT)
XX(WRT)
XX(ROT)
XX(→)
! XX(ANGLE);
XX(VDOT)
XX(VCROSS)
XX(CONSTRUCT)
XX(SQRT)
XX(SIN)
XX(COS)
XX(ASIN)
XX(ACOS)
XX(ATAN2)
XX(LOG)
XX(EXP)
XX(VVROT)
XX(SDIV)
XX(STOS)
XX(NOMV)
];
define
op_count=0;
redefine xx(str1, str2)=[
redefine op_count=op_count+1;
ifc "str2"=null
thenc redefine xxtemp=[define str1] & "_X=op_count";
elsec redefine xxtemp=[define str2] & "_X=op_count";
endc
xxtemp;];
operator_definitions;
redefine xx(str1,str2) = [ "str1", ];
preload_array(OPERATORS, OPERATOR_DEFINITIONS, STRING, 1, OP_COUNT);
! reserved_words;
define reserved_definitions=[
brace_definitions
cm_definitions
statement_definitions
operator_classes
require_definitions
move_definitions
misc_definitions
];
define
reserved_count=0;
redefine zz(name)= [];
redefine qq(name)= [];
redefine xx(name)=[
redefine reservEd_count=reserved_count+1;];
redefine yy(name, special)=[
redefine reserved_count=reserved_count+1;];
reserved_definitions;
redefine xx(name)=["name",];
redefine yy(name,special)=["name",];
preload_array(
reserved_words, reserv@∃H1IK→S]Si%←]fX↓gieS9NX@b0AeKgα+K[↔!C∂?Ww!%l4PH'K↔&+≠';*βki#v 7∃%mX4($HKK↔∪,3';∃ε≠3πO≠jm ;∞k∃
uXh($$Mil4(HKK↔∪.3';∃πCa#;∞k∃%vXh($$M∪↔∪↔6K;∃βGCS↔7βjo;πn*u↓→α⊂bJ⊗~⊃l4(HH'K↔&+≠';*β∂3π≥→vm v 7∃
kX4($J↓↓↓βGCS↔7αbul4PH'K↔&+≠';*βge#v 7∃3∨β↔∂'∞a%v@1Q HH≡,V&.m≥f*π∨≡F.oπTε≡f≡>2α2!
$-~'1PPH∀∧ααπ∨~F.o¬KSXh!⊃↔π⊗]Mv∞! ≡'⊗∂∃↓PW⊗↑8W↔6\Cε≡f≡:2`O,↑6/↔l\AF&\m⊗vOM≥vw~D ⊗w&\|W∩bε∃Bπ⊗↑8W↔6\Cε≡␈]nBKXQ!⊂O⊗\LV6NlTπGB
l⊗n*D∞7ε.=≤⊗bKY1PPH∀∧ααε≤hλd∧\|→,=8;λG]];≠∧∞~→;L4 λ→-Ny8h∞>→8z,≥λ→;LLk↔.aQB"4L\→9R-l(≡>%
X;9%D≤|⊂∩Xtpv∀OmFE∧BP⊂⊂⊂~s1P⊃≤x2qtXv⊃≡w≥v6⊂:~2s1P ⊂2v)YqP9x→qtpvλ2s21K.]FEαDx92[4πad_array(
αresarvEd_spEcial, resErved_definitions, integeR, 1, reseRved_count);
whilec [resarv@∃H1G←U]h@|rUeKMKemK⊂1QCg!Kd↑bA:AI← ~∀∪7IKckSIJ@D~)% ' I-⊗⊃¬"ε
2*α:>Q∧∩&≥α,r>V≡@aα↑εdaα∩>,∩2¬αM!8$)∩β7↔O≡ ∨∃↓Xh(4(O∪↔β↔4K;∃β⊗+O/.hV!F ≡6F/'↑&/≡↑.f.!
↔∞F↑!7⊗/<↑'6.C
ε∂≡ ↑#]hQ!⊂HH⊃_ -l_c"A⊃<⎇≤M≥Yh_..X>#!.Y<y..Y9⊗fπ\Y<l↑]Y9β
_<r ↑K(7'1"B"-≥]→9l↑H_<N >#"L={&≥∂≡→6dπ.Y<q..Y9ε
<z→.%,7 ≥CEαEβ⊂Dtw~z 92\p¬rv@∃Hv~∀4∃M←e]CeHAM∪≠!→∀A∪≥$*≡⊗I¬αJ>∞,"VJ∃∧BεN!E~RJ&t9αMnLrRε≡-⊃α6εBIl4(hSCK?≤∧V'<Y(
≥X=ε∞,<y0→≥2r≥FB⊂⊂⊂⊂⊂9z9~w3P9Nβ inte`∂Kdαβ%1βYX4(4R↓↓↓β⊗{?3↔∞qβCK|≠↔βW⊗)β≠'v cOgjCOSKNs⊂~π70π⊗.lX L]Xy(
≥]→9l↑H~j'1 ¬∧Aλ9z94[3P8 2obe+
k ← has@ QfHAβ∪↔O↔↔3↔⊂@
↔=→<@∀NFE∧`7hile (probe ← @IKgKeYKI7WtR7]k1XAI↑4∀∩@@ASLAα+GU#~aβCK|∧&*J∞Mε.r∞,W'<[@∀≥9:rTH2p c@∀AVA>QVF@λ¬∩εNβy⊂≤2yr`2ved_hashe@Hv~∧∪β∪↔SW⊗q#≠πdε6*Kαc"A⊂nc"AQHλλ∧ <\XmNJ≤Y.<αy; %d)3 @¬aeGYβ⊃#∂∨iCSgC*Il4$∧ααεmp≤D
(↔hε∀≤⎇→.∧ (⊂~[:4v⊂≤2yr`2vedλcmuftthen α if reserved_class[i] ≠ SEX_RES then
outstr(reserved_words[i] & " doubly defined!" & crlf);
β
else
α
reserved[k] ← reserved_words[i];
com_type[k] ← reserved_class[i]+reserved_special[i]*reserved_hasher;
β;
require "<><>" delimiters;
s ← decipher_compiletime();
require unstack_delimiters;
outstr("COMPILED "&s&crlf&crlf&"***** macro delimiters are now ⊂⊃ ,
multi-token macro arguments and macro bodies must be delimited by ⊂⊃");
β;
require init_reserved initialization [0];
! predefined constants;
define constant_definitions=[
XX(GARB_ID, scalar, nil) ! do not move this entry;
XX(PI, scalar, nil)
XX(π, scalar,nil)
XX(INCH, scalar, distance)
XX(INCHES, scalar, distance)
XX(CM, scalar, distance)
XX(SEC, scalar, time)
XX(SECONDS, scalar, time)
! XX(GM_MASS, scalar, mass) ;
XX(DEG, scalar, angle)
XX(DEGREES, scalar, angle)
XX(RADIANS, scalar, angle)
XX(GM, scalar, force)
XX(OZ, scalar, force)
XX(LBS, scalar, force)
XX(OUNCES, scalar, force)
XX(XHAT, vector, nil)
XX(YHAT, vector, nil)
XX(ZHAT, vector, nil)
XX(NILVECT, vector, nil)
XX(NILROTN, rot, angle)
XX(NILTRANS, trans, distance)
XX(STATION, trans, distance)
XX(YPARK, trans, distance)
XX(BPARK, trans, distance)
XX(YARM, trans, distance)
XX(BARM, trans, distance)
XX(YHAND, scalar, distance)
XX(BHAND, scalar, distance)
XX(TRUE, boole, nil)
XX(FALSE, boole, nil)
XX(CRLF, string, nil)
];
define
const_count = 0;
redefine xx(str, i1, i2)=[redefine const_count = const_count+1;];
constant_definitions;
define zap_const(name, type, arg, postfix)=[
ifc "postfix"=null
thenc redefine xx(str, i1, i2)=[arg,];
elsec redefine xx(str, i1, i2)=[arg] & [postfix,];
endc
preload_array(name, constant_definitions, type, 1, const_count)];
zap_const(
preconst, string, "str");
zap_const(
preconst_type, integer, i1, _VALUE);
zap_const(
pre_dimens, integer, i2, _METRIC);
! predefined macros;
define macro_definitions=[
! XX(DIRECTLY, [ WITH APPROACH = NILDEPROACH WITH DEPARTURE = NILDEPROACH]);
XX(CAUTIOUS, [ SPEED_FACTOR ← 2.0])
XX(SLOW, [ SPEED_FACTOR ← 3.0])
XX(CAUTIOUSLY, [ WITH SPEED_FACTOR = 2.0])
XX(SLOWLY, [ WITH SPEED_FACTOR = 3.0])
XX(SECOND, [ SECONDS ])
XX(DEGREE, [ DEGREES ])
XX(RADIAN, [ RADIANS ])
XX(LB, [ LBS ])
XX(OUNCE, [ OUNCES ])
XX(NILVEC, [ NILVECT ])
XX(NILVECTOR, [ NILVACT ])
XX(NILROT, [ NILROTN ])
XX(SETUP_BARMF, [ FRAME BARMF;
AFFIX BARMF TO BARM AT TRANS(ROT(XHAT,180*DEGREES),NILVECT*inches) RIGIDLY; ])
XX(SETUP_BGRih⊗∧VP#) SbP!#T ih≥CE∧D`Q#$l⊂⊂#i iT⊂*'P⊂ i&P⊂j⊂*)⊂g)T)∪j∀$$⊂j⊗_L ∃""cT biTK'$f+⊃aj∃4[1t2yJP)$cRb&,]H.TFE⊗,∀$g∩j `f∩m"V∧VP&gk⊃P! i∪P*'P⊂( i%H+dj$λ"*a U$gg⊂λ≡P→U∀bagg⊃)]FEαDgh"S⊂!$ S"⊂*'H→W_∃∩g!d"T]P.TCE,,∀∪'L'*S&⊗∧mH''L'∃f&$g⊃P.TFB,,∀ T()'l∩f`j"S,V∧mH+dj$λ''L'∃f&$g⊃P.TFB,,∀(∀ ¬CISELY, [ WITH NULLING ])
];
! compiler switches and control tabh Kfl~∀~∀∧AβfAQQJAβ0AG←[ASYJAQS[JAMsgiK4Aek]LX@Agα+[↔K∞aβ';&+K'↔&KπS∃ε3'3↔~βπK∃ε≠K↔π&+⊂4 αβπ;⊃ε#↔OS⊗{g↔⊃p↓αS#*β∪↔≠∂+3Qβ/CS↔;≡K?;Mε{→βSF+O* m⊗f/4 ↔⊗*
I↔∨&\Dε⊗.M}rph!Q"αα∧¬d `⊃≡W≡∂!≡FF*λ→D<|Dλ
≥y(⊂)D≤{⎇. y(≠ ≥Y⎇8,|!"H∧∧λ S xb=<l↑B9Z-L(≠qD <\[n.h→→.L8⎇→,D_↑(∞M→(∀λ~Tq4AQHλλ∧¬Tq6↓_3α<e\>≤∀L↑|z3md≥Y<N=;{@
|H⊂3∧∞{⎇<L<(_slL!"H∧∧λ P)Jλ
H→
"(→⊂b<∞<=9≠d {y→!QHλλ∧¬P3∃∧¬ P3ε∃"03λ1=≤X-,8⎇≠n/(→Z-L!"H∧∧λ P)JH
H→ J"(→⊂b0m⎇\⎇_-n≤h_-lλ≥X.-88[ T→→1M≥Z=~-⎇\h→M}H≤≤l↑9≠h =y→#!$λλλ¬h3∀h¬¬P3 e⊃03⊂a≡};8M⎇λ≥_,-α2P:\pq6"H1<P*~2P("∀⊗XX@≤:w:4[p¬ system
.ALL ALC hybrid s-eXpression/Read AL listifg
.LST PALX P@P-11 assembly code listing
.@IN PALX PDP-1⊃ binary fIle lOadedby 1⊃TTY
.DMP 11TTY PDP-11 core image¬
;
! compiler switches;
αdefife compiler_switches=[
xp(K, false) ! keeP extraneouq intermeDiate files: .ALP, .AHV, .ALT≠
xx(S, false) ! inhibitthe deletion o@_AiQJX
N⊗@β≠'3+X4+cBB11β6 3O∃HI¬β∨.s↔Kπ&)β¬α∧
2aβ∂≠O↔↔⊗ceβ3O≠S';8π0hW∂¬∧rb l⊗g≡U⊃∩
π>|↔απMt∧ d9hU 4~;\nL89⊂≠pε AL@εv~∃apQ∧X↓MCYg∀R∩BAIkTA¬¬∪_AS5[KIS¬iKIr↓C@≠S,ε"π≡<≥fvNlpλ∞M→(⊂m⎇8εpw→⊂64w→]FE,≡∀"V⊂→0v9`%) ! Load the .BIJ f@%YJAS9i↑Ai!JA! @Zbbv4⊃:`,hP4 'v#'∂↔~C∂?7∧¬⊗f/#∞7>OL9ε/~βλε ¬,¬FEαDr2`&ine
switch_max =xxcount-1;
reDe`
S]∀Aq`Q9C[JX↓IKMCUYhB{lAP≠πn) 2uX∧αππ,X
|9ε_..X>*↓Q\⎇z.Lzε≠L≥9+α,={<⊂∀[2y 9]tz1`(es, String, 0, switch_max+1);
λ∧∩∩∪β∪↔&\h
-l(≡⊂≤
4εame, de@→Ck@3 ¬∪m↑LX L≡8ε:,]; Predo@¬H1CEICrP~)goSi
P1IKα3πWN@ ↓≤{{4
≥→<F∞>z=_m <kλ -{{⊂∩Xw∩⊂_ ⊂9{t]1t 6X|⊃P⊃$r~∧∩%EW←Yα+π9β∂∪@⊗∂⊃Q'∨>≡L6AG<X
∞M8π3mL≥9{t]1t 6X|.P≠
λ∧∩+∧ε&}≡\NW⊗*∞ L↑y=ε∞>z=_m <jc!∧λλλ$~;] \βry i;
f@=`ARA|@`Agβ#↔A↓λπW;SL¬Bπ∨⎇_
≥∧∧6p↑⊂27P≤{tz1Z 9r`4ti`≥OmS:A>↓goSi
P1IKα3πW∪αK6Mkαc"D∧λλgFEεE≤2xz`)re p@IKgKhagoSi
QKfAαK;'SL∧⊗fO,≡FN}i0 Wc"@↓D(~_.t⊂ @⊃KGYCICiS←8AP∨→∧#↔ W>;';≥π3πK≤≤&f/5Dπ∨&≡.Bε@yH∩
≤α22`._parse;
λS@∪≠A→∃αLrR,xZ"¬¬)x4,%X∧Q$ ⊂4r¬
u∀R)hβP)]RdεTEGER MAX)0⊗~(@@@@λA∪≥$*≡⊗I∧I2R> ¬D7c"H∧∧λ⊂wi≠l.`⊂λ*'j/L≥FE⊂λ⊂⊂ ↔HIHE I≠0 DO TOT←TOT+!π7εVβ %)"Mz2>AE→%%@1Q"αα∧
$-∃0 '
*#j MH∂λA5β Rv4⊂ ↓↓α
l4Ph ⊗Nl4ε&.,¬0∪F1sv`0ile QQK@;_I¬βO|¬V*πl≡&N∞-@ .P:40]⊂1pwλ12P 5pπ@↔⊃∧∧fo∩ LV↔9yz-ll¬FEαy2xzZy2P⊃⊂αREAK,¬⊃ %hbP∩BU`∩$≤p↔`5p¬GJ⊃α3'3∀β1P@! ∧DDα@ ∪$A)$@#∞sdc∞d∧↔>h∧FEελ9_⊗λ λλr__s8, __s9;
integer
__i0, __i1, __i2, __i3, __i4, __i5, __i6, __i7, __i8, __i9;
real
__x0, __x1, __x2, __x3, __x4, __x5, __x6, __x7, __x8, __x9;
procedure debug_init;
α
__r0 ← __r1 ← __r2 ← __r3 ← __r4 ← __r5 ← __r6 ← __r7 ← __r8 ← __r9 ← null_record;
__s0 ← __s1 ← __s2 ← __s3 ← __s4 ← __s5 ← __s6 ← __s7 ← __s8 ← __s9 ← null;
__i0 ← __i1 ← __i2 ← __i3 ← __i4 ← __i5 ← __i6 ← __i7 ← __i8 ← __i9 ← 0;
__x0 ← __x1 ← __x2 ← __x3 ← __x4 ← __x5 ← __x6 ← __x7 ← __x8 ← __x9 ← 0.0;
β;
require debug_init initialization[0];
endc
! The following (making all of parse a recursive procedure) is a hack to get the
restart option to work properly. As soon as a better way is found of
making sure everything gets reinitialized properly, this should be taken
out;
IFC FALSE THENC
recursive procedure hidden_parse;
α "hidden_parse"
ENDC;
! ---- DECLARATIONS ----;
external integer
rpgsw;
RPTR(file)
AL_file, ! AL source file;
SEX_file, ! s-expression file;
BIN_file, ! PALX binary file;
ALL_file, ! ALC listing file;
LOG_file, ! LOG listing file;
NEW_file,
PRESENT_file; ! Present file;
BOOLEAN
DISK, ! TRUE IF INPUT IS COMING FROM DISK;
AUTO_PROCEED, ! TRUE IF AUTO_PROCEED SWITCH IS ON FOR ERROR RECOVERY;
IGNORE_CORRECTION, ! TRUE IF DONT WANT TO MODIFY BUT JUST CONTINUE;
LOGGING, ! TRUE IF LOGGING WANTED;
COMPILE_LOGGING, ! TRUE IF LOGGING WANTED THROUGH REQUIRE STATEMENT;
now_top_file,
LOG_FILE_OPEN,
STRICT_DIMEN_CHECK;
ifc dup_file thenc
BOOLEAN
WANT_DUP_FILE; ! TRUE IF WANT CORRRECTED FILE;
endc
STRING
cmd_line,
INFILE,
OUTFILE, ! INPUT,OUTPUT & LOG FILES;
NEWFILE,
LOGFILE;
INTEGER
CHANIN,
CHANOUT,
CHANNEW,
CHANTTYO,
CHANLOG;
STRING
OUTSTRING,
PARSED_STRING,
INSTRING, ! INPUT STRING;
TABLE1; ! BREAK TABLES;
! GET_TOKEN VARIABLES;
REAL
REALNUM;
INTEGER
TYPE_OF_RES_WORD, ! TYPE PULLED OFF OF COM_TYPE;
SPECIAL_INFO, ! INFO PASSED FROM SCANNER TO PARSER - DEPENDS ON TYPE;
ID_TYPE,
ARRAY_TYPE,
PROCEDURE_TYPE,
BLOCK_LEVEL_OF_DEFN,
RESERVED_TOKEN_PTR,
TYPE_OF_TOKEN;
define
special_token =-1,
undeclared_token=0,
id_token =1,
numeric_token =2,
string_token =3,
macro_token =4,
MACRO_BODY_TOKEN=5,
metric_token =6,
reserved_token =7,
array_token =8,
procedure_token =9;
STRING PROCEDURE TOKEN_TYPE_TRANSFORM;
α string s1;
s1← CASE TYPE_OF_TOKEN OF ( "undeclared","id","numeric",
"string","macro","macro_body","metric","reserved","array","procedure");
return(s1&"_type");
β;
STRING PROCEDURE ID_TYPE_TRANSFORM;
α string s1;
s1← CASE (ID_TYPE + 2 )OF ("string","form","boole","scalar",
"vector","rot","frame","plane","trans","event","atom",
"world","on_label","calculator_label",
"changer_label","statement_label");
return(s1&"_type");
β;
STRING
TOKEN,TOKEN2,
TOKEN_FRONT;
RPTR(ANY_CLASS)
TOKEN_PTR;
! END GET_TOKEN VARIABLES;
integer
word_R_break, ! break tables;
non_blank_break,
word_S_break,
close_brace_break,
non_digit_break,
quote_break,
macro_delimiter_break,
semicolon_A_break,
cr_break,
paren_cr_break,
lf_ff_break,
semicolon_R_break,
knvrt_break,
omit_break,
tty_input_break;
STRING
CURRENT_FRAME; ! TOKEN OF THE CURRENT FRAME - DEFAULT SET TO "YARM";
INTEGER
SPACING, ! SPACING FOR OUTPUT;
SAVSPACING;
BOOLEAN
REJECT, ! TRUE WHEN THE LAST TOKEN IS REJECTED BY THE CALLING PROC;
switch_file,END_FLAG;
INTEGER
DEC_NUM, ! THE NUMBER OF DECLARATIONS IN THE CURRENT BLOCK;
ARRAY_DEC_NUM,
PROCEDURE_DEC_NUM,
MACRO_DEC_NUM, ! THE NUMBER OF MACROS IN CURRENT BLOCK;
DIMEN_DEC_NUM; ! THE NUMBER OF DIMENSIONS IN THE CURRENT BLOCK;
STRING
OUTEXPR; ! FOR THE CONSTRUCTION OF THE STRING FOR EXPRESSIONS;
STRING
OPEN_BRACE;
INTEGER
CHECK_TYPE_VAR; ! RETURNS TYPE OF ID FROM CHECK_ENTRY;
STRING
MACRO_STRING;
! ERROR VARIABLES;
BOOLEAN
INSIDE_MACRO_DEFINITION,
INSIDE_DECLARE_P,
INSIDE_CONDITION_MONITOR,
INSIDE_STRING_DECLARATION,
INITIALIZE, ! INITIALIZATION PROCESS;
GLOBAL_BACKUP,
patch_code,
GLOBAL_MODIFIED,
PROMPT_FOR_MODIFIABLE_ERROR_ONLY;
INDEGER
NUM_OF_ERRORS,
INSIDE_STATEMENT,
NUM_OF_ERRORS_FLUSHED,
NUM_OF_ERRORS_MODIFIED;
! END ERROR VARIABLES;
↓INTEGER
RUNTIME;
! recorddeclarations;
RCLASS
λPARAM_DIST(
STRING
ID,
α USER_AD≠
↓ RPTR(PARAM_LIST
NEXT
);
α
RCH β'L~∃≠β
%≡1→%'(@~(∩∪')I∪⊂~≤hQ↓↓↓¬2ε2V*`$%¬∧
∞@%X→B∧l_:$zε-|GKXQ$ααα _CXh!⊃∀LuHXt-⊂Q$ααα jTkX⊃∀∩∧uYX$-∩ xb¬∧~(∀l-HZ%≠XQ!⊂M∃
J"Dl_:$yDβ∩4jE#"H∧∧λ∪Q+
α"$∀∀∪r)j∀h∃ t⊃Q6
D∪00j)h⊂ d∩a`λ HASHES T@≡AQ⊃αA≤
6∃α,rRJeXh)↓↓αα2εN ¬@HJ∀λ$ ≤4
∧|LhHU∩∧→`λ
I⊃(∀h→1(∪ ~u∞c!$λλλ I3R`≥BDPP*Tbb⊂'S&,P#∪i⊂( T fbj⊃i⊂"l∀ g!dSg⊗⊂(∪dg ∀S T@≡AQ⊃
4PH$%↓¬αεJεl*R⊗I∧"⊗~&t*⊃α*-~Qα
,2>J∃¬""&M∧z:∃lhP$&J¬"I"B
∩ε4bdJNQ$hQ↓↓↓¬αεJεm→l4(HJ&:R,:⊗H4R↓↓↓α∀b>∞,Db⊗Z⊗aB>_b$*~84RIl4(hP$&J¬"I"6 ~J<bdJNQ$hRR>@EαεJεh`4+∂,ε'⊗.nCεn∞>-r`h*Iu↓DX_5∀zAQ$≥4F∪(_tSnaQB"4J
∀J∪(_tSf I4u∀H i) VFA&`Pi'D*⊂a&"mL≥6pq\7L40\t2y.NFEεEβEεEεB∧Di!S iaFB&`ai∪L)j PePεEαDi(*∀∀&`aT'L&$Tj∀FEλ⊂⊂⊂&∩ij (∃)→FEαDi(*∀∀&`aT'L)j⊂aaTFB⊂⊂⊂⊂∀h aeF& NK
);
RPTR(MACRO1M)βπ⊗αH4*6 ~J<b≥"ε∞,E"6A0hR6ε∞α)qE≥F ∞aQ@εE∧Bi!f TiFE"∩dbg)F"hλPONANT(
∩∪M)%∪≥≤~∀@@A≥β≠∀v~∀∩%∪∃) ≥ $~∀@@A %' ∩εt~∃04R↓↓↓ααI∀l*A∀∩∧≤~hU~∧Xε∀ yβ"g*∀P ∂F VARIOUS COEFFICIEN@)Lv~∧@@A≠βM&X~∀@@Aβ9∂⊂∩∃`h)↓↓αα~>J≤)l4(HJJBR⊂B∩&6,rLb⊗β
∧|@Q3U¬⊃ ¬⊂⊂λ⊂'"l∃⊗εE⊂λ⊂⊂& Tj≥FEαDdg*⊃cbiεB⊂⊂⊂⊂⊂& ∂CK_LEFEL_GF_D@
≤4⊂R`,hP$&J¬"I"∩STANCE_DIMENS,
TIME_DIMENS,
! MASS_DIMENS;
ANGLE_DIMENS,
FORCE_DIMENS,
TORQUE_DIMENS,
VELOCITY_DIMENS,
ANGULAR_VELOCITY_DIMENS,
TOP_DIMENS, ! POINTS TO TOP MACRO IN THIS BLOCK;
EXP_DIMENS;
RPTR(DIMENS_EXPONENT) ARRAY
DIMENS_TABLE[0:metric_hasher],
D_TABLE[0:metric_max];
RCLASS
ID_LIST(
STRING
NAME,
BODY;
INTEGER
FLAGS,
TYPE;
RPTR(ID_LIST)
NEXT, ! POINTS TO NEXT ID WHICH HASHES TO THE SAME ENTRY;
LAST; ! POINTS TO THE ID DEFINED JUST BEFORE THIS ONE;
RPTR(DIMENS_EXPONENT)
DIMEN;
INTEGER
BLOCK_LEVEL_OF_DEFN
);
RPTR(ID_LIST) ARRAY
SYMBOL_TABLE[0:id_hasher];
RPTR(ID_LIST)
TOP_ID;
RCLASS
array_LIST(
STRING
NAME;
INTEGER
FLAGS,
#DIMENS,
TYPE;
RPTR(array_LIST)
NEXT, ! POINTS TO NEXT ID WHICH HASHES TO THE SAME ENTRY;
LAST; ! POINTS TO THE ID DEFINED JUST BEFORE THIS ONE;
RPTR(DIMENS_EXPONENT)
DIMEN;
INTEGER
BLOCK_LEVEL_OF_DEFN
);
RPTR(array_LIST) ARRAY
ARRAY_SYMBOL_TABLE[0:array_hasher];
RPTR(array_LIST)
TOP_array;
RCLASS
procedure_LIST(
STRING
NAME;
INTEGER
FLAGS,
#ARGS,
TYPE;
RPTR(PROCEDURE_LIST)
NEXT, ! POINTS TO NEXT PROCEDURE WHICH HASHES TO THE SAME ENTRY;
LAST; ! POINTS TO THE PROCEDURE DEFINED JUST BEFORE THIS ONE;
RPTR(DIMENS_EXPONENT)
DIMEN;
RPTR(id_list,array_list) ARRAY
ARGS;
INTEGER ARRAY
isid,ARGMODE;
INTEGER
BLOCK_LEVEL_OF_DEFN
);
RPTR(procedure_LIST) ARRAY
procedure_SYMBOL_TABLE[0:procedure_hasher];
RPTR(procedure_LIST)
TOP_procedure;
RCLASS
SOURCE_LIST(
INTEGER
CHAN, ! i/o CHANNEL NUMBER OF input, -1 if from macro;
NUM, ! NUMBER OF PARAMETERS IN THE CURRENT MACRO;
PN,
LN; ! PAGE AND LINE NUMBER OF THE PUSHED FILE;
STRING
CUR_STRING, ! curline WHEN PUSHED;
CUR_STRINGR, ! curliner WHEN PUSHED;
FILE_NAME, ! NAME OF THE INPUT FILE WHEN PUSHED;
P_STRING,
MACRO_STRING;
RPTR(SOURCE_LIST)
NEXT;
RPTR(MACRO_STACK)
MACRO_STACK_TOP;
RPTR(MACRO_LIST)
CUR_MACRO;
RPTR(FILE)
COPY_FILE,
FILE_PTR;
INTEGER
CHANTTYO,
CHANNEW
);
RPTR(SOURCE_LIST)
TOP_SOURCE;
! other declarations;
INTEGER
EXP_TYPE; ! TYPE OF EXPRESSION FOUND BY P_EXP;
BOOLEAN
PLAN_STATEMENT; ! TRUE IF CURRENT STATMENT IS PREFIXED BY PLAN;
STRING
CHANGER_HEAD; ! NON NULL IF PARSING A STATEMENT INSDIDE A CHANGER;
INTEGER
T_COUNT, ! COUNTER FOR PRODUCING UNIQUE ID'S;
S_COUNT; ! COUNTER FOR PRODUCING UNIQUE SCALARS;
BOOLEAN
NO_OP_SO_FAR,
OP_EXPECTED; ! TRUE WHEN P_EXP EXPECTS AN OPERATION;
INTEGER
DELIMITER_1,
DELIMITER_2; ! HEAD AND TAIL DELIMITER OF macro bodies;
INTEGER
MAC_NUM; ! NUMBER OF PARAMS IN THE CURRENT MACRO EXPANSION;
INTEGER
BLOCK_LEVEL;
! GARBAGE DECLARATIONS (VERY LOCAL);
BOOLEAN
T,
EOF;
INTEGER
COUNT,
I,
N,
BRCHAR;
STRING
GARB;
INTEGER
LINENUM,
PAGENUM,
SOSNUM,
typed_page_num, ! on tty;
sourcelvl;
STRING
CURLINER,
CURLINE;
! error, error_recovery, error_reject, print, file_indent;
FORWARD RECURSIVE PROCEDURE P_STATEMENT;
FORWARD RECURSIVE PROCEDURE GET_TOKEN(boolean noexpand(false));
FORWARD PROCEDURE OPEN_DOGGING_FILE;
forward RPTR (ANY_CLASS ∩AA%∨π ⊃+%
A
⊃ π⊗a ≥)%d@Q' I∪≥∞ALvAβ≥Q ∂ $↓)β¬→∀1)3!∀Rv~∃→←eoCIHA%!Q$@Qβ921π→¬'&@%¬αJ>∞,"VJ∃∧J:N⊗∃ b⊗:%∩e↓"≥"J&::αMl4PJ&:R,:⊗Iα$
2∀E"fB∃ZαJBR∩Bε:dD~2εN~IαJI
B:V2aBJ,9z$"J↔1PPh,iw↔≡≡,Bε⊗⎇x \;H≤∞-xy9∞↑Y(→m}ε≠u.N≥=
*∃∀J m;→*$λNh≤nNZ;Yd >≥
n;≠
%↔c"C!*T⊃∀Eλ3R&λ9α iiJP()'Pbb*i⊃P"i)∪i 10\tqT$S*"cbT⊂$]iU)$g#H)T]FBεEεEαPP$P→7w∪zλ:w22\9z0w→⊂:42H2y97\⊂7:vX2y⊂9]:s3↔λ⊂ v&λ2y97\9P7:[q2y2Y⊂→__βE∧P⊂~0{2P_2rw⊂_p22rλ1<P6YP0w2λ1pw⊂_2P0y_4z90\4v<P≤2pyyZsw2r εEεEαDDDDT%⊂≤πLX↔[[βEεE∧H$P9t≠zv2⊂~0{2P≠pr2P≥44yP_wvvr[:⊂2p\64ri ⊂1:`4 didn't. The epror
number Iq meanifgless to the user. IT is even usefuL to The~∀%aKOaαc∃β7}#'≠gNs∃αB
∩N∃1π#=βSF)β↔c&+;Qβ&CπQβLεBεF]Nπ4≥≠h m9⎇0→→FE∧w]z⊂;t→y2P*~2P2`2ror iq coMing in from inthe sourcE prograe.
AcTually, the error numbers shouLd be usedto indicate on
which pag`
A←β⊃β3'v)βS#*β∂?∪*β'M9αα;W↔⊗+K';8∧εn∂∀ &*π↑8 ,n;β"A≤[|@⊂≥42P:\ry⊂4Y⊂;rP≥pw:⊂≥7P40]2P0@≤vpv&λ80y9Yy⊗⊂ [2⊂9`4ore
error messages on a disk file.
MSM 3/5/7`@v~∀λA∪≥$*≡⊗I∧aE2⊃⊂π2α∧)ytd,→`¬¬∀x8T,#4∧∧LUHXt-∩λ9tll→hAD≤λ~#J∧)ytd,→`¬$-*8SXh**¬%∩λ→eID9H∃≥~α(∀
)pq1
ZQ(⊃**StF
(αagk⊃i,T$S*"cbT⊂ T]CE$c⊂∩↑XYP∃$"g⊂⊂)(*∀∀ b ∪$ij∧Q_]FEαgjb)U)∀!i∪#∪⊂⊃⊂ww:4[:rP 7ill declare it internally")3
D1←INSERT_ENDRY(TOKEN,ID_TYPE_TABLE);
ID_LIST:TYPE@7⊂c;?)Iβ≥&1Yβ⊃+
l~∀β∪⊂1→∪'Pu¬→∨
⊗12-2⊗0@ xaD∧Xie\#≠[t∀dx91DdZhTcXQ!∃∀-JZ$rDF∃∪Xh!⊂0hTYJ4*Q)∀2∧↔VS*¬IλTr$∧π∨'-≥f*π74π≥}n]FcXQ!∃<D→HR∧dYhu$B
5∪kαλ→d"X~U$y
$|≤XXB∧$t hPα3u*Ju∀Bλ:S⊃ID∧U≡< T~;@ =|\Y,>λ→Z-L(IP⊃\4∧f& *");
`'⎇S]GQ]XvA!I_∞∞⊗,"}@%*XSXh!≥⊗2εL]f?&¬∞2I[∧λ
9H~-lZ;→+}nc"A⊃" naQB4Q*J4SJ j3∪ε
(αagi⊃∀YFEαAFE"S)bFE∀ j*i∪∀' ∃LL_RECORD);
¬
RPTR(ANY_CLASS) C10⊗~)gieS9H
βO␈+C∂∀Gβ?MlhRNBJLr≥α∩Lr∃2I→d-∪1Q'≡␈↑,6)G
}5z∀m→F*α$d∧LTi→D*2∧!B¬ε≤|Rα∩dλ55~λλ∀<,jYR[
∀dα∩b M⊗v*∧ DλuTj I3Q3JY*.c!)∩3Q+xu0S →β"]@ LINER←CURLIJERl~∃∪ ↓π⊃β≥%≤8Zb↓)⊃ ≤∧@BAM+¬')%)+)
↓ +≠≠dA!β%¬≠ ) I&A∨ ↓≠βπ¬<A
∨$ααJ,→D¬$D→hsXh!⊃∀LuHXt-∩ ⊗∩e∧~(∀iD9zTu#1Q HO=}W,y&≤
}whλH≡λλ@∪≤wzy1YL87yI1y6# ⊃4w9Zp∧e Macro "&`≠C
eV!YαKOQkL"g∂W↔∪↔;PFkπ∂K⎇il4(HK'2
H
-l<O4n 8y(∞M→;@⊂≠4p∞e@I?YS]∃e6dAβ#=:hπ0hP⊃→∀2αα⊂⊂*(3&⊂i@hg ∀←SH∂+∀~∀bI~5#Th¬3+:α'h ∀dπU@%
:R@x@`~∀$∪)",qλ∀PH$'O'∪';≥ε @↔⊗∨∀πε∂,≥QFNEH ≡X;& ≡Yv`_Nαparam_co@U]a:@Xh($⊃~%¬%%
ε∂⊗≥SεfO>@
$∞_<X-S≤≥≤G1bst(string old_string);
α string t,t1,old;
integer brchar,i1;
old←old_string;
t←scan(old,temp,brchar);
while brchar≠0 do
α t1←old[1 to l1];
old←old[l2 to ∞];
for i1←1 step 1 until param_count do
if equ(t1,param_arg[i1])
then t←t¶m_id[i1];
t←t&scan(old,temp,brchar);
β;
return(t);
β;
param_ptr←macro_list:params[current_macro];
source_pos←source_pos&"(";
for i1←1 step 1 until param_count do
α param_arg[i1]←param_list:id[param_ptr];
param_id[i1]←param_list:user_id[param_ptr];
param_ptr←param_list:next[param_ptr];
source_pos←source_pos¶m_id[i1]&",";
β;
l1←length(source_pos);
source_pos←source_pos[1 to l1-1]&")"&crlf;
l2←(l1←length(param_arg[1]))+1;
t←param_arg[1][1 for 1];
setbreak(temp←getbreak,t,null,"INR");
line←subst(line);
liner←subst(liner);
RELBREAK(TEMP);
β;
β;
WHILE EQU(LINE[1 TO 1], lf) DO GARB←LOP(LINE);
L1←LENGTH(LINER); L2←LENGTH(LINE)-L1; PROCEED←AUTO_PROCEED;
IF ¬PROMPT_FOR_MODIFIABLE_ERROR_ONLY OR global_backup
then α
IF global_backup THEN PROCEED←FALSE;
ifc debug_compile thenc
OUTSTR(crlf & "ERROR TYPE " & CVS(I));
endc
IF I<0 THEN OUTSTR(crlf &"WARNING: ") ELSE OUTSTR(crlf);
OUTSTR(S & crlf
& source_pos & crlf & LINE[1 TO L2] & lf & LINER & crlf);
β
ELSE IF PROMPT_FOR_MODIFIABLE_ERROR_ONLY THEN PROCEED←TRUE;
C1←ERROR_RECOVERY(I);
IF ¬LOGGING THEN IF COMPILE_LOGGING THEN OPEN_LOGGING_FILE;
IF LOGGING THEN
OUT(CHANLOG,crlf & "ERROR TYPE " & CVS(I) & crlf & S & crlf
& source_pos & crlf & LINE[1 TO L2] & lf & LINER & crlf);
IF IGNORE_CORRECTION THEN PROCEED←TRUE;
IF I<0 THEN PROCEED←TRUE;
WHILE ¬PROCEED DO
α
CLRBUF; OUTSTR("$"); DO COMMAND_CHAR←INCHRS UNTIL COMMAND_CHAR<0;
COMMAND_CHAR←INCHRW;
CASE COMMAND_CHAR OF
α
["b"] ["B"] α
OUTSTR("ail" & crlf);
IFC debug_compile
THENC BAIL
ELSEC OUTSTR("Sorry, Bail not loaded." & crlf)
ENDC;
β;
[cr] α CLRBUF; PROCEED←TRUE; β;
["c"] ["C"] α OUTSTR("ontinue with default recovery"); PROCEED←TRUE; β;
[lf] α PROCEED←TRUE; AUTO_PROCEED←TRUE; β;
["a"] ["A"] α OUTSTR("utomatic continuation");
IF LOGGING THEN OUTSTR(" and logging");
OUTSTR(".");
PROCEED←TRUE; AUTO_PROCEED←TRUE; IGNORE_CORRECTION←TRUE;
β;
["e"] ["E"] α OUTSTR("dit" & crlf);
CLOSO(CHANLOG);CLOSO(CHANOUT);
EDFILE(INFILE,LINENUM,PAGENUM+1,0);
β;
IFC FALSE THENC
["I"] ["i"] α OUTSTR("gnore trying to modify"&CRLF);
PROCEED←TRUE; IGNORE_CORRECTION←TRUE;
β;
ENDC
["r"] ["R"] α
OUTSTR("estart"); CURLINE←CURLINER←null;
USERERR(0,1,NULL,"S"); ! THIS IS A HACK AND SHOULD BE CHANGED
AS SOON AS POSSIBLE;
β;
["x"] ["X"] α OUTSTR("it" & crlf);
USERERR(0,1,NULL,"X"); ! DITT@≡A¬¬∨-
↓π∨≠≠∃≥(v~(∩∩εv4∃6Eh :∪6EPE:∩∧↓∨+)'Q$PEKIgJD@_AGeY_RvA)∃%' ?Q%+
v$εv~∀4∃6El :∪6EXE:∩∧↓∨+)'Q$PEKIE←gJλ@LAGIYLRvA) %M ?
β1'
v@ v~∀~)6E`Et∪6E :∪∪ ↓!β)π 1π∨ ∀A)⊃ 8~∀∩∩$∧~∀∩$∪∨+%~RI!⊗ S∂!π≠?WK≡)β∂?&)mβ7}#'≠eε3?33⎇;';≥εc';∃∩2∞J22Il4(HH&∞2∀∩V→@1Q HH→It$,E DLtZ%∪Xh!⊃⊂L≥X)DLtX+tLt9
tcXQ!⊂HL:Z$dLh[tdLh[3
¬It∧c∃T∧b∧≥Z)DLtZ'0hP⊃⊃∃∧
H9↓D≤xHU|4→J4+XQ!⊂HM
)t≤,XKu%∃XW0hP⊃⊃∀u,S t1DZ*$⎇∃3 T|$_i∀,%yjTiDxc∧-∃)z%→DYxDL4_XB[ 1Q HH⊂1PPH∀∧α∧,J8R∧⎇ZJ5%∩∧,↔&≡∧¬RαR%%"Rπ=}'↔JD
f}r↑ ↔&≡ ≤&f* ↑'⊗␈$¬"RR%$"4≥)HbKXQ!PUZ-T%hM4)R∃h→_b∧<Ix$ aλ(∀≤]Z∧¬$DYaPPH⊃⊂"¬≥J)∀t:
6∩e≠'1PPH⊃→u-%8J"B⊗|M⊗7J∞Mε*εm⎇Ff␈⎇≥f:∩∧d∧≥∀He∪Xh!⊃⊂M∧~*4,!
:E∀Lh{u∧
*8T!E:J$Ltth5-∀I→d-∪>6%}w]MCXh!⊃⊂M< →D*XZ∃*Eλ~%≤,C
5%∀→hrduYIBHh!⊃⊂L$t L≤J(%,31Q HH⊃~3
⎇88∀rEλ~%≤,C
5%∀→hrddcλd1D*(T ZH*$≤D~%∪Xh!⊃⊂HL_d¬≠
6⊂∧4⎇$ε∃kn>$ε␈∩∞6∃[
mw∩β≠Tβj∧HaPPH⊃⊃∩α¬IλTr$∞3∃␈6↔2¬≠≠}6≡∞e∞ε∂↔<\AG∨N-⊗v:D
F1Flcε↔⊗\≥2f↔,=ε∂∩↔03Xh!⊃⊂HL_d∧d,hzDBE6⊂
#6λ∃∩λYHλA→∪q⊃(E∀l*'4∀l7i→Pr∃iGhnaQB""!~lWtf$Tl)H:S⊃NaQB""$∧λnaQB""(:4S∩)h7pu*)∩3Q*+tlNaQB"")z5∀u
)3Qwjλ4Tq(C∀u∀I→QwsJY∪∞c!!""1iIpP3β 3q∩(i11↔j
Spq(X↔u∀JX,¬FEαDDcf∪a f ⊂ aejT/c f∀b]FEαDDg*SL'c ⊃i)'i∀L&gb∩c$bb↔g*fL∪c "i∀'i)L∪gb$c∩bb∃HNFE∧DBy2u2Xz/s0[9r]FB∧DDACE∧DbS)bP⊂λ'jj)U)∀⊃)[y9<P_pw∪zλ27P1_quzxλ∀YFEβEεE∧VQ∨Q.Bdc⊂αU"i)bH*$"gβE∧DAβE∧DgUj)b)
⊃)2x≠<P-aT.P7`2 ""C"" to continue," & crlf &
"[LF] or ""A"" to continue automaticallq," & crlf &
"""I"" to ignore trying to modify," & crlf &
"""E"" to ediT source file," & crlf &
"""R"" To restart " & crhf &
"""T"" fortersE," & crlf &
"""V"" foR verbose," & crlf &
"""X"" to exit");
IFC DEBUG_COIPILE THENC OUTSTR("," & crlf @DλE∧DD↓iVAY=C@A¬¬SXDRlA ≥ ~∀∩∪% @ →=∂∂∪≥≤A)↓ 8A∨+%~RI!⊂a ↓→∧≠K#→α1↓ ∀a↓ β4{Iβ3};∨'≠:⊃%l4PH&&→∧:2>
`b
ε≤ZVAα$B⊗9α⎇*RNR∩A 1 α1β∂Kf1↓ ↓∩⊃
5 ⊂β≠?Iεk?∪'7K';≥π≠?WK≡)β∂?&) %LhP$&>-"N@%%∧"r∩∧dε∨⊗Le∪Xh!⊃⊂_h!⊃∀,E8T∧⎇
J:E∩B)z¬$Lyj2ε∨%MF2dUJ"e"K¬D∩dEIRd:D ⊗v"
grε6} λ∞l<X[n<(IPj)⊃J.aQC"Vd-λW"+4SλW!→1H↓)Iqqr)hh⊃∩λY@εE∧BDAεEαD@gh⊃g &'Qcdg#F#$f"NFE∧DBgjj∀⊂d g&∪cV1y≠3⊂∪⊂λ i)'T⊂*,h⊃P⊃⊂∪λ!k)T∩TP∪⊂_y63⊂ ⊂)P∪λ1y63βE∧DDBS⊂9w]y1rL≤7yP∪λ1y63λ⊃⊂&$S"mXP∃'P&→↔P∪⊂6→⊂∪⊂&∩e"i ⊂1y6→∀]FEαD@gjU)j)∀λ5sst[3P4wλ34v2H70vrH⊃⊂∪⊂∪'cc$S P∪⊂_y63⊂
]FE∧BDAFEαDP⊂"S)bP'Uj)b)
⊃7ssZw3P0[92pr≡Q∀]FBεE∧bS)bP'Uj)b)
⊃⊂*g≤2qws[4⎇2rλ1t0y_qz2y∞P:<x→P⊃⊃∨H⊃⊂37\⊂0v6≠{pq6→P1t0\0qz2\9W⊃∪_y63∀CEεE∧BA]FEαA]FE∩c⊂$← ⊂*$"S⊂'*fF'c "T)'i)Wg*fL∪c "i∀'i)UL]FE#S'a fε! aeUh/c S)b]FB)"j*T'∀!XJ]FE↓NFEεE∀(*)∀⊂g,L!S iiTH()'aQb*i"H"i)'T 10yZqL)"R aj∀∩g*"cQi⊂$]Tj)$g⊃P)T]CE⊂⊂⊂λ↓⊂⊂)∀*)⊂∀⊂g,L!S iiTT_]P) oba)∪i 10\tqT$K)T]P∀"e"aU/j)*Q]P)"U*i'∀∀_T]P]FEεB()'aQb*i"H()$g∃∀)b)∩e#P)J]FE⊂λ⊂⊂↓εB⊂⊂⊂⊂~s1P2→q:sL_wvx4[2P7`2 true thenc commentused to be only debug_coMpile ;
INTEGERI,@∀Y,Y_v~(@@@A→∨$A∪|bA' ∃ @bAU≥)∪_↓'!βπ%≥≥α$yαN⎇⊂∧αα∩j70hR∧∧α∧UyHTtu∩α
5,¬FEλ⊂⊂⊂+R$f"P∩∨≤_⊂⊃'FE∧@≥FE∧Ro\_≥CE∧kd∩f"P%G%⊂ g⊃⊂αbhUT)`≠K T@≡A-:XD@λRA ≡↓↔?εVDr~∀∪% A∨+Q' ∩JLr≥M∧rV2D
DD,d w/'>N&Nv{x n↑≤⎇≤M≥YiXn-α3∪)VXP:7H%nFEαDbf)QP7rz≤z94g→oym@1 to K];
! KU@(!∞"εtzVA2≥YEαRzα.u↓2βπK∪2Il4λM~}NnX¬3
¬It∧Ukαc"A→Pπe⊗R]BE∧@]FE⊂λ⊂⊂$cλ'j`∀STRING≠H
+→0A)",qβ/W'≠SKπv:␈?W'≠SKπv9≠∂Kd∧b7_Q!∀,@∀q(
}=≤p~≤αi`≥O⎇`
l4R ↓↓α⎇*Q"∞D
:.V ¬E4 H⊂⊃\αh LRl~∀@@AK@3≤∧V_hαHλ∧∧⊂∧g*⊃cba2]FEλ⊂⊂#'T⊂ ←DA') @@bA,rR&1¬~Bε∞Lr∃α∩xJNm α↓∩Th
FBα IF OUTSTRIL¬≤@9jTdbλ¬∩λYβ⊂7`5tstbing←o@UigiE%]NMGβ∪3→≠_h ⊂LYJ4*ε|¬0~≤βtri@9O0∨Mβ1P@$(λλ @h¬T(BHANOUT,S & crl@_Rv~∀@@AK9IFv~(@@@@ p 4λhSCK|8 ,Nαy2P→4p e_ijde@9hAS]QK@∨↔⊂∧εJJαc"D∧λλAQHλλ∧∞α8 `!α+⊂cC∞;∀c;,¬R¬@h→P⊂[9rP≠
λ outs@Q` ! α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓↓↓↓α↓∃[∀→M@y⊂2)S:Rv4⊂ ↓↓α
l4Ph ∃∧∧SphX⊃0 "H()$g∃'b`∀; α α~∀α↓↓↓αL1α>⊗αJ5%∀→hq\@U3∪∧
⊂∧"gλ'`∃@(αB≤D→iu-λε'jU)j)$Rα@∞MπI→∧Bv4⊂ ↓↓β∪∧A∀"*,8¬⊗U)*bFBα THDner; β ELSE
CURLINE←CURLINER;
OUTSTRING←NULL;
ifc dup_file thenc
IF WANT_DUP_FILE AND CHANIN > -1 AND CHANNEW > -1 THEN
OUT(CHANNEW,PARSED_STRING);
endc
PARSED_STRING←NULL;
β;
RPTR(ANY_CLASS) PROCEDURE ERROR(INTEGER I;STRING S);
RETURN(ERROR_BASIC(I,S));
RPTR(ANY_CLASS) PROCEDURE ERROR_REJECT(INTEGER I;STRING S);
RETURN(ERROR_BASIC_REJECT(I,S));
PROCEDURE UNDEFINED_VAR(STRING VAR(NULL));
ERROR(0,"UNDEFINED VARIABLE "&VAR);
PROCEDURE UNAFFIXED_VAR(STRING VAR(NULL));
ERROR(0,"UNAFFIXED VARIABLE "&VAR);
! process_switches, got_input, got_output, open_logging_file, open_new_file,check_want_copy;
procedure process_switches(RPTR(file) F);
α RPTR(file_switch) swt;
swt ← file:switches[F];
while swt≠null_record do
α integer i;
for i ← 0 step 1 until switch_max do
if equ(file_switch:name[swt], switch_name[i])
then α switch_setting[i] ← true; done β;
if i > switch_max then
begin
outstr("""" & file_switch:name[swt] & """ unknown switch but will pass it through"& crlf);
switch_name[switch_max+1]←switch_name[switch_max+1]&file_switch:name[swt];
end;
swt ← file_switch:next[swt]
β
β;
boolean procedure got_input(RPTR(file) F);
α
if file:chn[F] < 0 then file:chn[F] ← getchan;
if file:in_bfrs[F]≤0 then file:in_bfrs[F]←12;
open(file:chn[F], file:device[F], file:mode[F], file:in_bfrs[F],
file:out_bfrs[F], count, brchar, eof);
if eof then
α release(file:chn[F]); file:chn[F] ← -1; return(false) β;
infile ← make_file_name(F);
lookup(file:chn[F], infile, eof);
if eof ∧ length(file:ext[F])=0 ∧ length(file:def_ext[f])≠0 then
α "try default"
file:ext[F] ← file:def_ext[F];
infile ← make_file_name(F);
lookup(file:chn[F], infile, eof);
β "try default";
process_switches(F);
return(¬eof)
β;
boolean procedure got_output(RPTR(file) F; STRING EXT(NULL));
α
string filename;
if file:chn[F] < 0 then file:chn[F] ← getchan;
open(file:chn[F], file:device[F], file:mode[F], file:in_bfrs[F],
file:out_bfrs[F], count, brchar, eof);
if eof then
α release(file:chn[F]); file:chn[F] ← -1; return(false) β;
if length(file:ext[F])=0 then file:ext[F] ← file:def_ext[F];
IF ¬EQU(EXT,NULL) THEN FILE:EXT[F]←EXT;
filename ← make_file_name(F);
enter(file:chn[F], filename, file:eof[F]); process_switches(F);
return(¬eof)
β;
procedure open_logging_file;
if ¬log_file_open then
α;
LOG_file←new_record(file);
copy_file_record(LOG_file,BIN_file);
file:mode[LOG_file]←0; file:in_bfrs[LOG_file]← 0;
file:out_bfrs[LOG_file]←12; file:ext[LOG_file] ← "LOG";
file:device[LOG_file]← "DSK";
file:name[LOG_file]←file:name[AL_file];
if ¬got_output(LOG_file) then
usererr(0, 1, "can't get output");
CHANLOG ← file:chn[LOG_file];
LOGFILE←make_file_name(LOG_file);
log_file_open←true;
logging←true;
β;
ifc dup_file thenc
procedure open_NEW_AL_file(RPTR(FILE)B; STRING EXT);
α
NEW_file←new_record(file);
copy_file_record(NEW_file,B);
file:mode[NEW_file]←0; file:in_bfrs[NEW_file]← 0;
file:out_bfrs[NEW_file]←12; file:ext[NEW_file] ← EXT;
file:device[NEW_file]← "DSK";
file:name[NEW_file]←file:name[PRESENT_file];
CHANNEW ← (file:chn[NEW_file] ← getchan);
if ¬got_output(NEW_file,EXT) then
usererr(0, 1, "can't get output");
NEWFILE←make_file_name(NEW_file);
β;
endc
RPTR (file) procedure open_new_file(reference string s);
begin string word;
integer ignore_blanks_break,file_name_break,ppn_break,break;
RPTR(file)F;
integer procedure ignore_blanks(reference string s);
begin integer break; scan(s, ignore_blanks_break, break); return(break) end;
string procedure filwrd;
begin ignore_blanks(s); return(scan(s, file_name_break, break)) end;
setbreak(
ignore_blanks_break ← getbreak, space & tab, cr, "XRK");
setbreak(
file_name_break ← getbreak, "[:.," & lf, cr, "ISK");
satbreak(
ppn_break ← getbreak, "]" & lf, cr, "ISK");
F←new_record(file);
word ← filwrd; fiLe:chn[F] ← -1; ! file has not been opened flag;
if break=":" then begin fiLe:device[F] ← word;↓o←eH↓>AMS1oeHA∃]Hv~(@@@A→SYJu9C[K7→:A>A]←eHv4∀@@@↓SLAEIKCVzλ\DAi!K\AM%YJuKai7
:↓>AMS1oeHv4∀@@@↓SLAEIKCVz 6DAi!K\4PK ↔∨Np4('N;;?K)C &≥m7~G5↔2ε6≥LSWπ
k45J tα∃Z$∧bπ≡<≥bG~D∞πεq .&.∞5Dε↔⊗\≥2Jαd∧%j∪αc"A≥9H_N,8:o$+(H∃
;H_L\z;H
≤{[|LS_[_-m|j≤e↔h_\L\:h↔d
≠|
∞5(→;LGc"B,]Y∞c!$λλλ
≤H≠⊃-l⎇~
m;→.LL=Z0⊃Ymc.@)=0 then f@%YJuI∃mSGKm
2A>E∩NZ⊃l4)α↓↓βK/#WK9D1%l4R↓↓↓β.s⊃l4Ph"BJ|~⊗∩V∀)α∞",~,b↑ rPb∞⎇αel4PH αO'∪';≥π≠π[∃ZβOπ[-y
e Xh(%↓∧J→α⊗
)"~&d)j:εl*nBJ-~⊗:PD2&2⊗jb:V2bH4(%α↓↓αRD*9α&2β;?\G#?@c6K3∃β&C↔9α4J2∃@)h∀l-:
$-≤YjAD4→HUmz(→Dl →d"ε.β≤p∩H9p{ %←"N"l~∀∩∩∧@@A∨U)')$αB∞J221
S↔d∧W'O TεNw∞X
∧∞Y<=,↑⎇→9¬Dλ∃x-nα⊂:7H9p{ % of disk?(Y ob L∧RDRl~∀∩∩∧Aβ→)∃%≥β)%-∃αl*R"> ∧α¬≤~hU|Lh9¬∃;1Q Jα∧∧∧L2
8∃4*πPλ∧ (Hβ!!(λλ∧∧λ⊂
$⊃g
α @%A)$Q
%→
S l~∀α@@@@A→?∃ .a%⊗∞⎇∩⊃"~Lb∃%@1Q Jα∧∧ααε=zπIFm_ S∀Q0izQ
⊃EJ∀Q4hYUα⊃I→⊃*.aQ@(λ∧∧λλ⊂∪~v2] -o`e@7→;>`w→SYJuαK8c 5∪@≥\hπ7fπc"B$∧λλλ∧ Z;→'-⎇=ε ,\\vhk7l →∞β if file:ext[F]=nuLl then fi@1JuKqQ7E;> ))2Dl~∀∩@@@@A→SYJuα≠#:@<kUzK↔1PPJ∧∧αααλi∀d+αQ⊃*@$abmQ,oQ"∀eQ≥FB∧P⊂⊂λ⊂⊂$cλαcgjε'j`∀PUT F) T@EN USERERR(0,1,"Can't↓O@↔Q∧¬w/'∞X
∧∀X
CHANTTYO←FILE:C@N[FY3
β
ELSE CHANTTYO←)1;
β;
λ
∃¬=∨⊂∩⊗ qαBJ|~⊗∩Vα(R∧
93¬< jC∧%-βλdLdW1P@H$
5%∀→hr¬≠1Q L⎇X¬∀jJJ⊂tIHβ∪⊃+Pg*⊂*∪β SAVE DUPLICATE FILE (@2↓∨$A≤αI↓m↓⊂Il4(M~}&:≤BJ]m∧J→αMh∧%J∩ z"¬≠T/∩απM Vr¬(ZE-∀e
E∃,U∀ε.g<Tπ⊗/NX Me→X;∞<αT]FB ! push_source_list,pop_source_list,new_expr_rec;
RPTR(SOURCE_LIST) PROCEDURE PUSH_SOURCE_LIST(RPTR(SOURCE_LIST)S1);
α
RPTR(SOURCE_LIST) S;
S←NEW_RECORD(SOURCE_LIST);
SOURCE_LIST:NEXT[S]←S1;
SOURCE_LIST:CUR_STRING[S]←CURLINE;
SOURCE_LIST:CUR_STRINGR[S]←TOKEN_FRONT&CURLINER;
SOURCE_LIST:PN[S]←PAGENUM;
SOURCE_LIST:LN[S]←LINENUM;
SOURCE_LIST:CHAN[S]←CHANIN;
SOURCE_LIST:FILE_NAME[S]←INFILE;
SOURCE_LIST:FILE_PTR[S]←PRESENT_FILE;
SOURCE_LIST:CHANTTYO[S]←CHANTTYO;
SOURCE_LIST:CHANNEW[S]←CHANNEW;
! SOURCE_LIST:P_STRING[S]←PARSED_STRING;
! PARSED_STRING←NULL;
PRINTOUT;
CHANTTYO←-1;
CURLINE←CURLINER←NULL;
RETURN(S);
β;
RPTR(SOURCE_LIST) PROCEDURE POP_SOURCE_LIST(RPTR(SOURCE_LIST)S1);
α
CURLINE←SOURCE_LIST:CUR_STRING[S1];
CURLINER←SOURCE_LIST:CUR_STRINGR[S1];
PAGENUM←SOURCE_LIST:PN[S1];
LINENUM←SOURCE_LIST:LN[S1];
CHANIN←SOURCE_LIST:CHAN[S1];
PRESENT_FILE←SOURCE_LIST:FILE_PTR[S1];
INFILE←SOURCE_LIST:FILE_NAME[S1];
CHANTTYO←SOURCE_LIST:CHANTTYO[S1];
CHANNEW←SOURCE_LIST:CHANNEW[S1];
! PARSED_STRING←SOURCE_LIST:P_STRING[S1];
RETURN(SOURCE_LIST:NEXT[S1]);
β;
! id info processing routines;
! FLAGS
BIT 35 USE
34 DEFINE
33 AFFIX
0-9 PAGENUM
10-19 LINENUM ;
DEFINE RID1=[RPTR(ID_LIST)R1];
BOOLEAN PROCEDURE USED(RID1);
RETURN(ID_LIST:FLAGS[R1] LAND '1);
BOOLEAN PROCEDURE DEFINED(RID1);
RETURN(ID_LIST:FLAGS[R1] LAND '2);
BOOLEAN PROCEDURE AFFIXED(RID1);
RETURN(ID_LIST:FLAGS[R1] LAND '4);
PROCEDURE USE(RID1);
ID_LIST:FLAGS[R1]←ID_LIST:FLAGS[R1] LOR '1;
PROCEDURE DEFIN(RID1);
ID_LIST:FLAGS[R1]←ID_LIST:FLAGS[R1] LOR '2;
PROCEDURE AFFIX(RID1);
ID_LIST:FLAGS[R1]←ID_LIST:FLAGS[R1] LOR '4;
PROCEDURE UNFIX(RID1);
ID_LIST:FLAGS[R1]←ID_LIST:FLAGS[R1] LAND '777777777773;
PROCEDURE PUT_ID_PAGE(RID1);
ID_LIST:FLAGS[R1]←(((ID_LIST:FLAGS[R1] ROT 10)LAND '777777776000)+PAGENUM+1) ROT -10;
PROCEDURE PUT_ID_LINE(RID1);
ID_LIST:FLAGS[R1]←(((ID_LIST:FLAGS[R1] ROT 20)LAND '777777776000)+LINENUM+1) ROT -20;
INTEGER PROCEDURE ID_PAGE(RID1);
RETURN((ID_LIST:FLAGS[R1] ROT 10)LAND '1777);
INTEGER PROCEDURE ID_LINE(RID1);
RETURN((ID_LIST:FLAGS[R1] ROT 20)LAND '1777);
DEFINE AID1= [RPTR(ARRAY_LIST) A1];
BOOLEAN PROCEDURE array_USED(AID1);
RETURN(ARRAY_LIST:FLAGS[A1] LAND '1);
BOOLEAN PROCEDURE ARRAY_DEFINED(AID1);
RETURN(ARRAY_LIST:FLAGS[A1] LAND '2);
BOOLEAN PROCEDURE ARRAY_AFFIXED(AID1);
RETURN(ARRAY_LIST:FLAGS[A1] LAND '4);
PROCEDURE ARRAY_USE(AID1);
ARRAY_LIST:FLAGS[A1]←ARRAY_LIST:FLAGS[A1] LOR '1;
PROCEDURE ARRAY_DEFIN(AID1);
ARRAY_LIST:FLAGS[A1]←ARRAY_LIST:FLAGS[A1] LOR '2;
PROCEDURE ARRAY_AFFIX(AID1);
ARRAY_LIST:FLAGS[A1]←ARRAY_LIST:FLAGS[A1] LOR '4;
PROCEDURE ARRAY_UNFIX(AID1);
ARRAY_LIST:FLAGS[A1]←ARRAY_LIST:FLAGS[A1] LAND '777777777773;
PROCEDURE PUT_ARRAY_PAGE(AID1);
ARRAY_LIST:FLAGS[A1]←(((ARRAY_LIST:FLAGS[A1] ROT 10)LAND '777777776000)+PAGENUM+1) ROT -10;
PROCEDURE PUT_ARRAY_LINE(AID1);
ARRAY_LIST:FLAGS[A1]←(((ARRAY_LIST:FLAGS[A1] ROT 20)LAND '777777776000)+LINENUM+1) ROT -20;
INTEGER PROCEDURE ARRAY_PAGE(AID1);
RETURN((ARRAY_LIST:FLAGS[A1] ROT 10)LAND '1777);
INTEGER PROCEDURE ARRAY_LINE(AID1);
RETURN((ARRAY_LIST:FLAGS[A1] ROT 20)LAND '1777);
DEFINE PID1= [RPTR(PROCEDURE_LIST) P1];
BOOLEAN PROCEDURE PROCEDURE_USED(PID1);
RETURN(PROCEDURE_LIST:FLAGS[P1] LAND '1);
BOOLEAN PROCEDURE PROCEDURE_DEFINED(PID1);
RETURN(PROCEDURE_LIST:FLAGS[P1] LAND '2);
BOOLEAN PROCEDURE PROCEDURE_AFFIXED(PID1);
RETURN(PROCEDURE_LIST:FLAGS[P1] LAND '4);
PROCEDURE PROCEDURE_USE(PID1);
PROCEDURE_LIST:FLAGS[P1]←PROCEDURE_LIST:FLAGS[P1] LOR '1;
PROCEDURE PROCEDURE_DEFIN(PID1);
PROCEDURE_LIST:FLAGS[P1]←PROCEDURE_LIST:FLAGS[P1] LOR '2;
PROCEDURE PROCEDURE_AFFIX(PID1);
PROCEDURE_LIST:FLAGS[P1]←PROCEDURE_LIST:FLAGS[P1] LOR '4;
PROCEDURE PROCEDURE_UNFIX(PID1);
PROCEDURE_LIST:FLAGS[P1]←PROCEDURE_LIST:FLAGS[P1] LAND '777777777773;
PROCEDURE PUT_PROCEDURE_PAGE(PID1);
PROCEDURE_LIST:FLAGS[P1]←(((PROCEDURE_DIST:FLAGS[P1] ROT 10)LAND '7777↔70∞nl@``RWAβ∂ ≥U~VbR↓%∨(@4b`v~(~∀A!I∨π U%
A!U(1!%=π +I
1 ∪9
Q!∪⊂bRv~(∪!%∨
+%∀1→∪'Pu
→β≥'7 Cu>PPQA%∨π ⊃+%
11∪'(u→→β∂'m c:AI∨ @d@S→β≥⊂@Nnn\nnnn\l```$W→∪≥∃≥+~VDRA%∨P@Zd`l~∀~∀↓∪≥) ≥ $A!I∨π U%
A!I∨π U%
1!¶
Q!%λbRv4∀∪% Q+%≤P!!%∨π∃ +%
a→∪'(i
→β∂M7 c:↓%∨(@D`S→β9λ@Nb\nnRv4∀~∀A%≥) ∂∃$A!%=π +I
A!%=π +I
1→∪9
Q!∪⊂bRv~(∪% )U%≤PQA%∨π ⊃+%
11∪'(u→→β∂'m c:AI∨(@d@S→β≥⊂@Nbn\nRv~(~∀_BAe∃CHv~(~∃∪≥Q ∂ $↓¬%π⊃¬$dv~)')%∪9∞A!%=π +I
A↔≥Y%(Q'Q%∪≥∞↓∨→λ1M)$Rv4∀∪% Q+%≤P↓'πβ≤!∨→λ1M)$XA-≥-%(a¬% β,XA¬%
⊃β$d$Rv~∀4∃')%%≥∞A!I∨π U%αA%∃βλQ∪9) ∂ HA¬)β →
Rv4∀∩BAI∪∂⊃(↓≥∨.AQ⊃∪&AA%∨π ⊃+%
A%&A↔∪9λA∨ ↓ +≠∧8@A∪(≥&A∪≥
→+ ⊂A∪≤AQ⊃
A⊃=!
∀$@A∨ ↓ - ≥Q+β→→dA≠β↔%≥∞A)!
A% ¬ ∪≥∞↓
βπ∪1∪)2A5∨%
AY %'βQ∪→
v4∀∧A'Q%∪≥∞↓) 1(1) 1(Hv~∃i∃qhA>↓'πβ≤!π+%→%≥ $Y )β¬→∀Y¬%π!β$Rv4∃∪ A
⊃β≥∪8@|@ZDA)⊃ 8~∃∪ Q¬)β →
{/=%λ1&a¬% β,RA∨$Q¬)β →
{π1∨'
1 %βπ
a¬% β,RA∨$Q¬)β →
{#U∨)
1 % β⊗$~∀∪∨H@Q¬)¬¬→
{5βπ%≡a →∪5∪) $a¬% β,R~∀∪=$@Q¬Qβ¬→
u∨≠∪(a¬% β,RA∨$Q¬)β →
{ Q21∪≥A+(1¬I β⊗R@~∀∪Q⊃ ≤AAβ%' ⊂1')%%≥∂?!¬%' λa'!%∪9∞M) a(M¬%
⊃β$~(∩∪ →M
A!βI' λ1M)%∪≥≥?!β%M λ1'Q%∪≥∞→) 1(l~∃/⊃%→
A¬Iπ⊃β$t`A ≡4∀∩∧A ∨∨→ ¬≤A% A→βπ ⊂v~∀∪I !→β
?)I+
`,hP&&→∧~"ε:Lqy5E¬""⊗9⊃↓αN%∩&:≥∧~VJIXh($&≥*J2&t*}∞Vα)DLtX∧Wi→T∃5¬λr⊂3I→K≠→C YF_N,8:j'1"B")_H⊂rλ→U∃⊗)s,λ∃ λ3H∪jZλ⊂rλ→U∃⊗)uλ⊂u*)∩3Q%↔c"B!≥88tMs≤⎇_,=f≥≠n {88n-f≤⎇ε'h≠8,>[f≤nFW{]-Mε≤Y,=|Y∞`7c"B!QB21Dλr⊂3I→G ,$
∩⊃3AQB" D∧\≠|∧
88|MtC"B!_r⊂3I→WtsjZPq& I4u∞H9⊂3VjItε∀iz4Pq+Wc"B!_u0S →Q3tiz4Pq# ∩4uπ(u4F
:∀R3H{u∪tβ
su4H87.c!! 0u*)∩3Q*+βigjT!bL&∩ij≥!Ui )j∀$g#i⊗h'h ∀eja!QnX
PAGENUM←SH∂+¬
12M~QjBuZR>@E~>FJ≤*ul4PH&2εOURCE_LIST:LN[TOP_SOURCE];
macro_stack_top←macro_st2←SOURCE_LIST:macro_stack_TOP[TOP_SOURCE];
CURRENT_MACRO←SOURCE_LIST:CUR_MACRO[TOP_SOURCE];
TOP_SOURCE←SOURCE_LIST:NEXT[TOP_SOURCE];
IF (BTABLE=WORD_r_BREAK) OR (BTABLE=word_s_break) OR (BTABLE=non_digit_break)
then α brchar←space; return(text); β;
β "pop macro"
ELSE IF BRCHAR=lf THEN LINENUM←LINENUM+1
ELSE IF BRCHAR=ff THEN
α
outstr(" " & cvs((PAGENUM←PAGENUM+1)+1));
typed_page_num ← true; LINENUM←0
β
ELSE IF TOP_SOURCE≠NULL THEN
α "close_source"
printout;
RELEASE(CHANIN);
if channew ≥ 0 AND (NUM_OF_ERRORS_MODIFIED >0)
then α BOOLEAN FLAG;
IF ¬ASK_WANT_DUP_FILE THEN RENAME(CHANNEW,NULL,0,FLAG);
RELEASE(CHANNEW);
β;
IF EQU(FILE:DEVICE[PRESENT_FILE],"TTY")
THEN if chanttyo ≥ 0 then RELEASE(CHANTTYO);
CURRENT_MACRO←NULL_RECORD;
MAC_NUM←SOURCE_LIST:NUM[TOP_SOURCE];
TOP_SOURCE←POP_SOURCE_LIST(TOP_SOURCE);
outstr(crlf); typed_page_num ← false; sourcelvl ← sourcelvl-1;
β "close_source"
ELSE IF EOF THEN
IF BLOCK_LEVEL > 0
THEN ERROR(500,"End of file encountered unexpectedly"&crlf&
"Probably BEGIN-ENDs have not been matched.")
ELSE RETURN(NULL);
TEXT2←SCAN(CURLINER,BTABLE,BRCHAR);
IF CHANIN>-1 THEN
IF (BTABLE=WORD_S_BREAK) OR (BTABLE=CLOSE_BRACE_BREAK) OR (BTABLE=QUOTE_BREAK)
OR (BTABLE=MACRO_DELIMITER_BREAK)
OR (BTABLE=OMIT_BREAK) OR (BTABLE=TTY_INPUT_BREAK)
THEN PARSED_STRING←PARSED_STRING&TEXT2&BRCHAR
ELSE PARSED_STRING←PARSED_STRING&TEXT2;
TEXT←TEXT&TEXT2;
β;
TOKEN2←TEXT;
IFC FULL_SET THENC RETURN(KNVRT(TEXT)); ELSEC RETURN(TEXT); ENDC
β;
! macro handling routine;
BOOLEAN procedure macro_handler;
α "macro_handler"
INTEGER HASH_ENTRY; STRING MACRO_NAME;
INTEGER PARAM_COUNT;
RPTR (MACRO_LIST) MAC_POINT;
RPTR (PARAM_LIST) TOP_PARAM, NEW_PARAM, LAST_PARAM;
BOOLEAN STATUS;
LABEL FLUSH;
PROCEDURE F_STATE(VALUE INTEGER PP,IP; VALUE STRING SP);
α STRING CLOSE; INTEGER I;
FOR I←1 STEP 1 UNTIL PP DO CLOSE←CLOSE&")";
SPACING←SPACING-PP;
PRINT(CLOSE);
ERROR(IP,SP&crlf&"Continue will flush statement.");
WHILE ¬EQU(TOKEN,";") DO GET_TOKEN;
REJECT←TRUE;
STATUS←FALSE;
NUM_OF_ERRORS_FLUSHED←NUM_OF_ERRORS_FLUSHED+1;
GOTO FLUSH;
β;
STATUS←TRUE;
do α "define_macro"
INSIDE_MACRO_DEFINITION←TRUE;
PARAM_COUNT←0; GET_TOKEN;
INSIDE_MACRO_DEFINITION←FALSE;
IF TYPE_OF_TOKEN≠undeclared_token and SPECIAL_INFO=BLOCK_LEVEL
THEN F_STATE(0,56,"Can only define unreserved ID's.");
MACRO_NAME←TOKEN; GET_TOKEN;
IF EQU(TOKEN,"(") THEN
α "macro_parameters"
TOP_PARAM←LAST_PARAM←NEW_RECORD(PARAM_LIST);
WHILE ¬EQU(TOKEN,")") DO
α
GET_TOKEN;
IF TYPE_OF_TOKEN≠undeclared_token
THEN F_STATE(0,57,"Can only use unreserved ID's as parameter names.");
PARAM_COUNT←PARAM_COUNT+1; NEW_PARAM←NEW_RECORD(PARAM_LIST);
PARAM_LIST:NEXT[LAST_PARAM]←NEW_PARAM;
PARAM_LIST:USER_ID[NEW_PARAM]←TOKEN; LAST_PARAM←NEW_PARAM;
GET_TOKEN3
IF ¬EQU(TOKEN,")") AND ¬EQU(TOKEN,",") THEN
α
ERROR(58,"Need either comma or right paren here.");
REJECT←TRUE; TOKEN←")";
β;
β;
TOP_PARAM←PARAM_LIST:NEXD[TOP_PARAM];
GET_TOKEN;
β "macro_parameters";
IF ¬EQU(TOKEN,"=") THEN ERROR_REJECT(59,"Need = here.");
GET_TOKEN;
IF TYPE_OF_TOKEN≠MACRO_BODY_TOKEN THEN F_STATE(0,60,"MACRO BODY DEFINITION REQUIRES DEFINITION BETWEEN ⊂ AND ⊃")
ELSE
α
! bind macros;
if param_count>0 then
α "PARAMS"
string array param_id, param_arg[1:param_count];
integar i,width,digits;
stringt13
string t, procassEd_token3
STRIH
∞A %ββ⊗a' ∩JLr≥l4PH'OS⊗K;≥β ε#Xh!⊃∃∃¬J%πε∂,≥QFf≡>BJπ ≡&∞i∞∞G∪XQ!⊂Oε≡,⊗iG∞N%␈&|βπε∂,≥SXh!⊃∀¬∀X→1E≥J)∀t=yjTdc1Q HLxZD4⎇)X∃"Ey_E$BHI∀<MJ5∪Xh!⊃∃≤-Hiu∀l~Eαk∩F¬∪Xh!⊃⊗N2 =ε∞v≥gcαπM VrπF≠r∪β∧ ε.g<Tπ#
|>g~F≤.2F≡ ≥fNr∃↔0hP⊃≤f␈∩
∀¬zβ∀∞7&/∧ε∩π.nM⊗bπ ≡&∞i =w.wD Fxh!⊃⊂H⊂Q!⊂HO ≡&∞i
≤E↑M[}ε∂⊗≥SεfO>G'/≡↑#εN%> ↔⊗∞S∞π'∃W1PPH⊃≡ε∂⊗≥Sε∂⊗{=∃mz∞ ↔⊗∞S
FO∨G)⊗%← ≡&∞i∞∞G∃mt∧!!B$iT ≥)s∧t XTg#
∧dα⊃A∧$f∨75
∩JK1Q HH≡ ↔⊗∞S∞π'∃} ↔⊗∞S
FO∨G-f/GK>ε∂⊗≥Sππ'+W0hP⊃⊃⊂≠XQ!PPH~8U$4z)T
"λy∀%$¬HDL<~J2KXQ!⊂Oπ-x6/∨<\AG&⎇<Vuz jTdc1Q HNMt⊂h!⊃⊗NwL\v/∩ .&≡F≡ .Xz_.&L¬FEαDz→/\qpw∀≥7urw 77w _4∧ank_break(brchar);
Id∧Ahdm]cYX↓iQK\αβCK?≤+@∨≡\Cπ&}<]eoπ-xλl↑|y1β∞≠zy-dβ:→;
↓ T←scan(token,wo@IH1f1 eKCVαc K∂F @∪∩↔1PPH≥_ D∞∧¬w:[6⊂:4→w
α for i←1 step 1 Until param_count do
Id equ(t →a¬aCZ1%I7S:$AiQK8Ai?a¬aCZ1¬eO7Stv~∀∩$∪ae←α≠↔OO. cS?↑+:␈C⊗{∂/>8 ,C≥≠zl]I]≥CE∧DD@]FE∧Bts⊂1≤1t0y
w:v≠⊂:42[⊂897Xp¬ss@∃H1i←-K]?aβ∪?∂↔∨≠↔⊂c&{/.dl',z_<F'c"B!⊂h≥0↔≥4v⊂ ,ength(token)50;
@Q←WK]⎇ae←G∃`∂O↔!CS?/.ql4(HH
↓
∧
Jε6~⊃l4(hP%¬β&{;∃β⊗K;∪'v9β7π≤ε&␈≠1Q H≠1Q hPβ"B-≤β⊂1t_w4w∞ X@
then iac_point←insepp⊂eNtry(macro_naee,macro_in_macro_type_tabl@∀R~∧∩%KYgJ↓[CF1A←S]i⎇S]gKβ∪Pc↔w#Ce#n ∂K<Fsπ7∃dkπ∂KyCSgC)CSπ d∧RKXQ!∀l 8∧Sc ∩4uπ*P3∃([pε`aF( ∂INTY←TOKEN+
MACRO_LIST:NUM[MAC_P@∨∪9);?!¬%β~1
≠+≥(l~∀β≠¬π%≡⊃1∪'(uAβ%β≠M7⊂⊗ε→BB>→jEm⎇Iz↓E∧~(∀kXQ!∀l 8∧Sc ∩4uπ(S∪pi3⊂ε"k⊃fλλOF_@
97∪βεa!∨&u"v}
dz∞,bd*Z⊗1Xh('∨/ cS?↑+9l4PH
↓ &+≠'≠)C7π∂⊗yλ$ α↓↓βWw#'1.+GU#&{/π9b↓ 1 KX4)↓α↓β'→∧∧W∂*∞Mv↑;Kλ∧'hJ(∞M→;@∞,:Y8nD↔h≥∞.9.c!(S∃4iπH⊂Q*J4SJ
:⊂5∃*5,¬FEβE⊂⊂⊂λ↓P⊃6Xqy7L~0w26→y⊃≥FBα ! e@aaC@;!C7π∂⊗yl4(hRBJ>≤*∩VJ*α⊗bB r⊂b⊗ ~J="∃αRI"l
∞J<Db&NQL~6ε∞α)rKXQ "M*
E∩F\≤7⊗Yα≠⊂∀\z⊂P&L]FE)U)$g#H()'aQiibbε!#b,NFE)(∃)∀ ∪OURCE_LIST%≥⊗\E~>VJ≤)Il4UαJ>∞-~N⊗⊂D∩>∩f|rV"1Xh(&:-8bN>-∩∞∃J|r⊗\@
(T≤@tQα
9βj`∩CE_@→∪M(Rf~(∪'∨+Iπ
1→%'(uπU$1≠β
%∨7≥∃( bN⎇*J∞∃∃j}∞Vα*$,U@ε∪(_tSnaQPq4J(3Qε X0p 'Waj`∩_MACBO;
α α "ex@AC]HA5CGe↑λ~∀∪'Q%∪≥∞αα6ε DJ⊃mαα*¬%∩λλ∃∀ S DM≥E∀¬∧
(→U≠XQ!∃≥∀R3Ht⊂Sq ↔c"B)→U⊃1hZH⊂THd i29
M1←CMA
read(non_blank_break); token←read(word_R_break);
if token=null then token←read(word_s_break);
IF ¬EQU(BRCHAR,"(") AND PARAMS≠NULL
THEN ERROR(59,"Parametered macro used without params.")
ELSE IF ¬EQU(BRCHAR,"(")
THEN
α
IF TOKEN= NULL
THEN α CURLINER←BRCHAR&CURLINER;
PARSED_STRING←PARSED_STRING[1 TO ∞ - 1];
β
ELSE α CURLINER←TOKEN2&CURLINER;
parsed_string←parsed_string[1 to length(parsed_string) - length(token)]; β;
BODY←MACRO_LIST:VALUE[M1];
β
ELSE
α "macro parameters"
STRING T,t2r,t3;
FOR I←1 STEP 1 UNTIL MACRO_LIST:NUM[M1] DO
α RPTR(MACRO_LIST)SUB_MACRO;
IF EQU(TOKEN,")") THEN
ERROR(60,"Number of parameters disagree with definition.");
GET_TOKEN(true);
SUB_MACRO←INSERT_ENTRY(PARAM_LIST:ID[PARAMS],MACRO_IN_MACRO_TYPE_TABLE);
MACRO_LIST:VALUE[SUB_MACRO]←TOKEN;
GET_TOKEN;
IF ¬EQU(TOKEN,",") AND ¬EQU(TOKEN,")") THEN
ERROR_REJECT(62,"NEED EITHER COMMA OR RIGHT PAREN HERE;
if you use more than one token as argument to a macro call, enclose it between the
macro delimiters ⊂⊃");
PARAMS←PARAM_LIST:NEXT[PARAMS];
β;
IF ¬EQU(TOKEN,")") THEN ERROR(62,"Number of parameters don't match the defn.");
body←macro_list:value[m1];
β "macro parameters";
PROCESSED_BODY←processed_body&body;
β "expand macro";
SOURCE_LIST:NUM[NEW_SOURCE2]←MACRO_LIST:NUM[M1];
SOURCE_LIST:NEXT[NEW_SOURCE2]←TOP_SOURCE;
SOURCE_LIST:CUR_STRING[NEW_SOURCE2]←CURLINE;
SOURCE_LIST:CUR_STRINGR[NEW_SOURCE2]←CURLINER;
SOURCE_LIST:PN[NEW_SOURCE2]←PAGENUM;
SOURCE_LIST:LN[NEW_SOURCE2]←LINENUM;
SOURCE_LIST:MACRO_STACK_TOP[NEW_SOURCE2]←MACRO_STACK_TOP;
SOURCE_LIST:MACRO_STRING[NEW_SOURCE2]←MACRO_STRING;
SOURCE_LIST:FILE_PTR[NEW_SOURCE2]←PRESENT_FILE;
SOURCE_LIST:CHAN[NEW_SOURCE2]←CHANIN;
IF CHANIN≥0 THEN CHANIN←-1 ELSE CHANIN←CHANIN-1;
MACRO_STRING←processed_body;
CURLINE←CURLINER←processed_body;
TOP_SOURCE←NEW_SOURCE2;
GET_TOKEN;
WHILE EQU(TOKEN,"DEFINE") DO
α
macro_handler; get_token; GET_TOKEN;
β;
β;
! get_token;
! THIS PROCEDURE GETS THE NEXT TOKEN.
STRING TOKEN ← TOKEN FOUND
INTEGER TYPE_OF_TOKEN← SPECIAL_TOKEN, NUMERIC_TOKEN, STRING_TOKEN, ID_TOKEN,
MACRO_TOKEN, METRIC_TOKEN, UNDEFINED_TOKEN, RESERVED_TOKEN
ARRAY_TOKEN, PROCEDURE_TOKEN
INTEGER TYPE_OF_RES_WORD ← -VE IF NOT RESERVED WORD
INTEGER ID_TYPE ← VALID FOR TYPE_OF_TOKEN=ID_TOKEN
INTEGER ARRAY_TYPE ← VALID FOR TYPE_OF_TOKEN=ARRAY_TOKEN
INTEGER PROCEDURE_TYPE ← VALID FOR TYPE_OF_TOKEN=PROCEDURE_TOKEN
INTEGER SPECIAL_INFO ← PERTAINS TO INFO ABOUT RES_WORD
INTEGER BLOCK_LEVEL_OF_DEFN ← PERTAINS TO BLOCK LEVEL OF DEFN
INTEGER RESERVED_TOKEN_PTR← POINTER TO POSITION IN RESERVED,COM[0:RESERVED_HASHER]
REAL REALNUM← REAL NUMBER FOUND
RPTR TOKEN_PTR← GENERAL POINTER TO TOKEN FOUND AS ID, ETC;
RECURSIVE PROCEDURE GET_TOKEN(boolean noexpand(false));
α "get_token" BOOLEAN T; INTEGER POINT;
RECORD_POINTER(MACRO_LIST) PROCEDURE LOOK_FOR_MACRO;
α RECORD_POINTER (MACRO_LIST) R1;
IF MACRO_STACK_TOP≠NULL
THEN R1←CHECK_ENTRY(TOKEN,MACRO_IN_MACRO_TYPE_TABLE);
IF R1=NULL
THEN R1←CHECK_ENTRY(TOKEN,MACRO_TYPE_TABLE);
RETURN(R1);
β;
! IF REJECT THEN α REJECT←FALSE; ! ************ ; ! RETURN; ! ************; ! β;
IF REJECT
THEN α CURLINER←TOKEN2&CURLINER;
IF CHANIN > -1 THEN
PARSED_STRING←PARSED_STRING[1 TO LENGTH(PARSED_STRING) - LENGTH(TOKEN2)];
REJECT←FALSE; β;
BLOCK_LEVEL_OF_DEFN←RESERVED_TOKEN_PTR←
ID_TYPE←TYPE_OF_RES_WORD←SPECIAL_INFO←-100;
TOKEN_PTR←NULL_RECORD;
TYPE_OF_TOKEN←special_token; T←TRUE;
WHILE T DO
α "while_T"
TOKEN_FRONT←READ(non_blank_break); TOKEN←READ(word_R_break);
IF EQU(TOKEN,NULL)
THEN
α "isolated break"
CASE BRCHAR OF
α
["."]
α REAL NUM; STRING S1; S1←CURLINER[2 FOR ∞];
IF "0"≤S1≤"9"
THEN α NUM←REALSCAN(CURLINER,BRCHAR);
TYPE_OF_TOKEN←numeric_token; REALNUM←NUM; TOKENP∨πY∞Q≥+4R@ε~(∩∩@@A →'∀@∧A)=↔ ≤e⎇)∨↔ 9>D\DlAπ+%1∪≥ ¬⎇π+%→%≥ %6HA)≡@9:v@εl~∀∩∩A∪ A
⊃β≥∪8@|@ZDA)⊃ 8~∀∩∩%!β%'∃λ1')I∪≥∂?Aβ%' ⊂1')%%≥∞LD8DM&clbA
∨HA→ ≥≥)⊂Q&DR@ZA1 ≥∂) Qπ+%1∪≥ $%:v~∀$@@@@@@@εl~∀∪ 1'
∩v4∀~∀∪m'#+∨Q :~∀$∩∧A%∃β_A≥U~vA'Q%∪≥∞↓&bv~(∩∩@A% Aπ⊃¬≥∪≤@x@ZbAQ⊃ ≤~(∩∩@AAβ%' ⊂1')%%≥∂?!¬%' λa')%∪9∞M→∨@Qπ+%1∪≥ $$v~∀∩$@A∪ D`D9
+%→∪9 %6b↓
∨$@E:8Dnλ~∀∩∩@@A)! ≤@∧↓&c?πU%→∪≥∃$vA e!
1∨_1)∂↔∃≥?]k5KeSFai←WK8vA% ¬→≥+≠⎇≥+~v4∀∩∩@@@@@@@A)=↔ ≥?
-&Q≥U~RvAI β→≥U≠?π-<Q)∨↔∃≤Rv~(∩∩∩@↓∪ Aπ!β≥∪≤|@Zb↓)⊃ ≤~∀∩∩$@A!βI' λ1M)%∪≥≥?!β%M λ1'Q%∪≥∞→π+%→%≥ %6DA
∨$↓→ ≥∂Q⊂Q&b$@ZA→∃≥∂)⊂!π+%→%≥ $Stv~∀∩$∩@ε~(∩∩@@A →'∀A)∨↔∃≤e?)=↔ ≥?Mck←i∀v~∀∩$ε~∀∩ v~∀@@A∪ ↓ #*QQ∨↔ ≤1≥+→_$A)⊃ 8@∧A¬∃βλQo=eH1&aEeKC,RvA)=↔ ≤e⎇)∨↔ 9?¬%π!β$v~(∩∩∩∩ v~∀@@ε@E%g←YCQKHAEIKCVDl~∀@A% A #TQ)∨↔∃≤Y∨!∃≤1¬%¬π
RAQ⊃ ≤AQ∨↔ ≥⎇%ββλ!GY←g∀1EeC
J1Ee∃CVRA∃→'
AQ?
β→M
v~∀@ε@E]QSYJa(Dv~(~∀~∃%LAi←-K\kI∃YS[SQKd0b4∀@Ai!K\
∀@∧@E→←k]Ha[CGe<1E←IdDAS]QKOKd↓YmXv4∀@Ai=WK]?IKCHQ5CGe↑aIKYS5SiKdaEeKC,RvAieaJ1←_1i←W∃\A>A5CGe↑aE←Irai←WK8v~∀@↓SLAEIGQCduIKYS5SiKd`dAiQ∃\AeKQke\vB@TT(TTTT(@v~∀AYmX↓>@dv↓SLAEIGQCdmIKYS5SiKd`bAiQ∃\AKeI←dPd@`X@E5CGe↑↓E←Ir↓gGC\↓Y←ghλRv~∀AI↑@4∀@@@∧Ai←-K\A>↓i←WK8@LAEIGQCdLAeK¬HQ[C
e↑1I∃YS[Sβ#↔Hc↔∪↔π-KX4)↓α↓β'→ε∪K∂#∂⊃w∪↔fK7'S/⊂aH4R↓↓↓↓αβS#↔p∧εg6βλ↔d
≥[ &⊃ Hλ∧∧λλ→-Ny(~,D_\Xm <O9 ]~;:.L<F_CE∧z4→w⊂6;≠⊂/P6≥6∃XFB∧rv9YP2y9≠y∀→_ ⊗⊂⊃6Xqy7P_7r<P≤qpw⊂≠7yz⊃
]FE⊂λ⊂⊂↓FB⊂⊂:w≥4v⊂ ,vl ≤ 0;
return; ! ************* ;
β "found_macro_bkdy";
IF TOKEN=dquote
THEN
α "found_string"
STRINGS13
TOKEN←READ(quote_break)9 TYPE_OF_TOKEN←string_tokan;
while curliner=dquote do α IF CHANIN > -1THEN PARSED_SDRIJG←PARSED_STRINC&(S1←lop(curliner$Rv~∀$∪i←W∃\A>AQ←WK\LA&bα↓→βK. ⊃#G,{S∀c↔∪↔π-KY
lhQ¬↓ RQ)))RQ)↓lM∩⊗BVα)cJα∀¬"RR%%"RR%$βXh$∧~α,iw.vC∞7'⊗≥lr∪XQ!PRλ≥H m⎇h→[n$≤Y<l↑]Y9∧∞IF TYPE_OF_TOKEN=special_token
THEN
α POINT←HASH(TOKEN,reserved_hasher);
WHILE ¬EQU(RESERVED[POINT],NULL) AND ¬EQU(RESERVED[POINT],TOKEN) DO
POINT←(POINT+1)MOD reserved_hasher;
IF RESERVED[POINT]=TOKEN
THEN
α "reserved word" INTEGER VAL; TYPE_OF_TOKEN←reserved_token; VAL←COM_TYPE[POINT];
RESERVED_TOKEN_PTR←POINT;
IF VAL≥reserved_hasher
THEN α SPECIAL_INFO←(VAL DIV reserved_hasher); TYPE_OF_RES_WORD←(VAL MOD reserved_hasher); β
ELSE α SPECIAL_INFO←0; TYPE_OF_RES_WORD←VAL; β;
β "reserved word";
α "not reserved"
RECORD_POINTER(ANY_CLASS)POINT,POINT2;
IF ¬("0" ≤ token ≤ "9")
THEN
α "MAC_TEST"
IF (TOKEN_PTR←CHECK_ENTRY(TOKEN,ID_TYPE_TABLE))≠NULL_RECORD
THEN α TYPE_OF_TOKEN←ID_TOKEN; BLOCK_LEVEL_OF_DEFN←ID_LIST:BLOCK_LEVEL_OF_DEFN[TOKEN_PTR]; β
ELSE
IF (TOKEN_PTR←CHECK_ENTRY(TOKEN,ARRAY_TYPE_TABLE))≠NULL_RECORD
THEN α TYPE_OF_TOKEN←ARRAY_TOKEN; BLOCK_LEVEL_OF_DEFN←ARRAY_LIST:BLOCK_LEVEL_OF_DEFN[TOKEN_PTR]; β
ELSE
IF (TOKEN_PTR←CHECK_ENTRY(TOKEN,PROCEDURE_TYPE_TABLE))≠NULL_RECORD
THEN α TYPE_OF_TOKEN←PROCEDURE_TOKEN; BLOCK_LEVEL_OF_DEFN←PROCEDURE_LIST:BLOCK_LEVEL_OF_DEFN[TOKEN_PTR]; β;
IF (POINT2←CHECK_ENTRY(TOKEN,DIMENSION_TYPE_TABLE))≠NULL_RECORD
THEN
α IF TOKEN_PTR=NULL_RECORD
THEN α TOKEN_PTR←POINT2; TYPE_OF_TOKEN←METRIC_TOKEN;β
ELSE IF DIMENS_EXPONENT:BLOCK_LEVEL_OF_DEFN[POINT2] > BLOCK_LEVEL_OF_DEFN
THEN α TYPE_OF_TOKEN←METRIC_TOKEN; TOKEN_PTR←POINT2;
BLOCK_LEVEL_OF_DEFN←DIMENS_EXPONENT:BLOCK_LEVEL_OF_DEFN[TOKEN_PTR]; β;
β;
IF (CUR_MACRO←LOOK_FOR_MACRO)≠NULL_RECORD and ¬noexpand
THEN IF TOKEN_PTR=NULL_RECORD OR MACRO_LIST:BLOCK_LEVEL_OF_DEFN[CUR_MACRO]>
BLOCK_LEVEL_OF_DEFN
THEN
α "MACRO"
BLOCK_LEVEL_OF_DEFN←MACRO_LIST:BLOCK_LEVEL_OF_DEFN[CUR_MACRO];
EXPAND_MACRO(CUR_MACRO);
β "MACRO";
β "MAC_TEST"
ELSE
α "numeric" REAL NUM1,NUM2; INTEGER NUMGARB;
TYPE_OF_TOKEN←numeric_token; NUM1←INTSCAN(TOKEN,NUMGARB);
IF ¬EQU(TOKEN,NULL) THEN ERROR(0,"Illegal token." & crlf & "Garbage after digits will be ignored.");
IF BRCHAR="."
THEN
α STRING S1; S1←CURLINER;
CURLINER←"0"&CURLINER; NUM2←REALSCAN(CURLINER,BRCHAR);
TOKEN←CVG(NUM1+NUM2);
REALNUM←NUM1+NUM2;
IF CHANIN > -1 THEN
PARSED_STRING←PARSED_STRING&S1[1 TO LENGTH(S1) - LENGTH(CURLINER)];
β
ELSE IF BRCHAR="@"
THEN
α STRING S1; S1←CURLINER;
CURLINER←"1"&CURLINER; NUM2←REALSCAN(CURLINER,BRCHAR);
TOKEN←CVG(NUM1*NUM2);
REALNUM←NUM1*NUM2;
IF CHANIN > -1 THEN
PARSED_STRING←PARSED_STRING&S1[1 TO LENGTH(S1) - LENGTH(CURLINER)];
β
ELSE α TOKEN←CVG(NUM1); REALNUM←NUM1; β;
β "numeric";
β "not reserved";
β;
if type_of_token=id_token
then α if ¬inside_declare_p then use(token_ptr);
if id_list:type[token_ptr]=string_value
then if inside_string_declaration
then id_type←string_value
else α type_of_token←string_token; token←id_list:body[token_ptr]; token_ptr←null_record; β
else id_type←id_list:type[token_ptr];
β
else if type_of_token=array_token
then α if ¬inside_declare_p then array_use(token_ptr);
array_type←array_list:type[token_ptr];
β
else if type_of_token=procedure_token
then α if ¬inside_declare_p then procedure_use(token_ptr);
procedure_type←procedure_list:type[token_ptr];
β
else if type_of_token=special_token then type_of_token←undeclared_token;
β "get_token";
boolean procedure check_next_token(integer err_code; string err_mess,
s1,s2(null),s3(null),s4(null),s5(null),s6(null),
s7(null),s8(null),s9(null),s10(null));
α string array s[1:10]; integer i1,j1;label l1,l2; string st;
s[1]←s1;s[2]←s2;s[3]←s3;s[4]←s4;s[5]←s5;s[6]←s6;s[7]←s7;s[8]←s8;s[9]←s9;s[10]←s10;
i1←0;st←null;
while s[i1+!]≠nulL do α i1←I1+1;st←st & s[i1] & ",";β;
if i1 >bAiQ∃\~∀∩λ~∀∪XDt∪OKP1i←W∃\v~∀$∪M←d↓Tc>b↓giK`bAk]QSXARD~∀∩∩%I↑AS_AKcj!i←WK8@XAgmTc:R↓iQK\↓eKikβ∪9#S↔+∃%LhP$'C∂#∂ c≤¬v&-}N'.+αc"A⊃9<\M}J→<Nβ_{y Uα2y9ε6ryyI1y63 ⊃'2rY⊂7w2H5s⊂⊃ 9z∪⊂λ⊂42y→V⊂80]1t0q≠2P2`2ror ");
if patch_code=true
then α patch_code←false;↓eKikβ∪9#≠∞cO∃%Z 4(HI↓β↔g≠∃↓β>{S=βc l4(H→β↔3≤∧PhP⊂!PPNF' N>↑Cπ&}<]cXh!⊃⊗N2 ↑↔*GM⎇6.rN6∩JπM Vrπ,ZG/⊗e∞G↔∞U↔0hP⊃≡ε∂&=βε≡}L[w'↔\W0hP⊃≤W↔⊗}%ε/↔# 6}εULW↔⊃
\W∂~l>&f2d)f..D∧"7≠∀d"εF↑,Rbε=⎇g&NnXRπ>≥IBεNn<W↔α
≡Br∩↔1PPH≥_bπε≡L6AF=|F*βT
G↔.QQ HJ∧
FF.d"πε≡L6AF=|F-}l≥G≡+4
&/'↑-bF6≥N6*K40hP⊃∀αε.N8 $ {⎇≠d
Nc!! nc!!"@naQC"XM⎇{→8-d≤≤[l<9≥4LT_z→,=f≥≠m<;J~-n→9y.$→<\C {y→'4≤⎇≤M≥Yh→..F≠9.>kβ"A⊃<l ⊗≤Y∀7:[6⊂V9LT7:v≠∀V9Z
7:v6
V9ZT≠:v6∀K9[∀7≥v6∀VβE∧DyMT7:v≠∀V9\
7:v6
V9\T≠:v6∀K9XX∀≠:v6∀J]FE↓βE92e→qz/j≤:r]FB92z:\7∀1t→quL7→|: :≠urw∀→y9 1[r2V2\9 6r\yV9XK9Y⊗9LV9Z⊗≤ZV9[ 9[V9N⊗9\V≤XX∀TNFE↓]CEεE1≠wv2p[⊂897Xrr:y→P1t2XuL72↑: :7Zrw :≡x2T4[:2sr\⊂2y9ε1wr2NP9z9~w3P2\9 6r\y]FEαDtw:→sry⊂≥:<x2J]FE↓αf0q2[⊂6_]CE∧sr] :7uYw≥FEλ⊂⊂⊂6 ]∧tsλ:<x2F7s :≠urw≡]:<x"H:42wλ92z:\7∀:9≥rT]FB∧x0z_t 1`/deWtrue0⊗~(∪Kee=dQKeH1G←I∀YKeda[Cgf$v~∀∪%HAaCQGP1G=IJ{iIkBAi!K\@∧↓aCiG 1G←I∃?MCYMJvAe∃ice\!MCYg∀Rv@ε4∀∩@A∃YgJA≥←i↑A0bv~∀ v~∀~)E←←Y∃C\AaI←GKIUeJAG!KGV1Q←WK\aisaJ!S]iK≥KdAKI`1G←⊃JvAgβ#K';8β↔KHFk↔OMXh($'NsS↔∨-⊃βSSOβ∃%LhPλ4+⊗++↔∂%{SKW+X4+K/#WK9F≠#↔∂YC;↔c!CS?/.pcSG∧)#↔K⊃C∂?∪*c↔KHFk↔OMg#SgC*I%l4P→l4(hS ??re token_equ(string s1,s2(null),s3(null),s4(null),s5(null),
s6(null),s7(null),s8(null),s9(null),s10(null));
α string s;
for s←s1,s2,s3,s4,s5,s6,s7,s8,s9,s10
do if equ(null,s) then return(false)
else if equ(token,s) then return(true);
return(false);
β;
! check, inverse, multiply and divide dimensions; ! CHECK_EXP_TYPE_DIMENS;
RPTR(DIMENS_EXPONENT)
PROCEDURE CHECK_DIMENSIONS_PROG(STRING S; RPTR(DIMENS_EXPONENT) D1,D2);
α RPTR(DIMENS_EXPONENT)II1,II2,II3;STRING SS;BOOLEAN SAME;
rptr(any_class) PROCEDURE ERROR(INTEGER I; STRING S);
α rptr(any_class) r1;
GLOBAL_BACKUP←TRUE; r1←ERROR_BASIC(I,S);
IF GLOBAL_MODIFIED = TRUE THEN α REJECT←FALSE; GET_TOKEN; β;
return(r1);
β;
BOOLEAN PROCEDURE ISNIL_DIMENS(RPTR(DIMENS_EXPONENT) DD);
α BOOLEAN B; B←TRUE; IF DD=NULL_RECORD OR DD=NIL_DIMENS THEN RETURN(TRUE);
redefine xx(temp)= [ B ← B ∧ (DIMENS_EXPONENT:temp[DD] = 0) ; ];
BASIC_DIMENSIONS;
RETURN(B);
β;
SS←NULL;
SAME←TRUE;
II1←D1; II2←D2;
IF II1≠II2 THEN
α IF II1=NULL_RECORD THEN II1←NIL_DIMENS;
IF II2=NULL_RECORD THEN II2←NIL_DIMENS;
redefine xx(temp)= [ IF DIMENS_EXPONENT:temp[II1]≠DIMENS_EXPONENT:temp
[II2] THEN α IF LENGTH(SS)≠0 THEN SS←SS&", temp " ELSE SS←" temp ";
SAME←FALSE;β;];
IF ¬STRICT_DIMEN_CHECK OR (¬ISNIL_DIMENS(II2) AND ¬ISNIL_DIMENS(II1))
THEN α BASIC_DIMENSIONS;
IF SAME THEN II3←II1
ELSE ERROR(122, SS & "Dimensions don't match on "&S&".");
β
ELSE IF ¬ISNIL_DIMENS(II1) THEN II3←II1 ELSE II3←II2;
β
ELSE IF ISNIL_DIMENS(II1) THEN II3←NIL_DIMENS ELSE II3←II1;
IF SAME THEN RETURN(II3);
β;
RPTR(DIMENS_EXPONENT)
PROCEDURE INVERSE_DIMENSIONS(RPTR(DIMENS_EXPONENT)D2);
α
RPTR(DIMENS_EXPONENT) D1;
IF D2≠NULL_RECORD THEN
α
D1←NEW_RECORD(DIMENS_EXPONENT);
redefine xx(temp)=[DIMENS_EXPONENT:temp[D1]←-DIMENS_EXPONENT:temp[D2];];
BASIC_DIMENSIONS;
β
ELSE D1←NULL_RECORD8↓@
RETURN(D1);
β;
RPTR(DIMENS_EXPONENT)
PROCEDURE SQRT_DIMENSIONS(RPTR(DIMENS_EXPONENT)D2);
α
RPTR(DIMENS_EXPONENT) D1;
IF D2≠NULL_RECORD THEN
α
D1←NEW_RECORD(DIMENS_EXPONENT);
redefine xx(temp)=[DIMENS_EXPONENT:temp[D1]←DIMENS_EXPONENT:temp[D2]/2;];
BASIC_DIMENSIONS;
β
ELSE D1←NULL_RECORD;
RETURN(D1);
β;
RPTR(DIMENS_EXPONENT)
PROCEDURE MULTIPLY_DIMENSIONS(RPTR(DIMENS_EXPONENT)D2,D3);
α
RPTR(DIMENS_EXPONENT) D1;
IF D2=NULL_RECORD OR D3=NULL_RECORD THEN
α
IF D2≠NULL_RECORD THEN D1←D2
ELSE IF D3≠NULL_RECORD THEN D1←D3;
β
ELSE
α
D1←NEW_RECORD(DIMENS_EXPONENT);
redefine xx(temp)=[DIMENS_EXPONENT:temp[D1]←DIMENS_EXPONENT:temp[d2]+
DIMENS_EXPONENT:temp[D3];];
BASIC_DIMENSIONS;
β;
RETURN(D1);
β;
RPTR(DIMENS_EXPONENT)
PROCEDURE DIVIDE_DIMENSIONS(RPTR(DIMENS_EXPONENT)D2,D3);
α
RPTR(DIMENS_EXPONENT) D1;
IF D2=NULL_RECORD OR D3=NULL_RECORD THEN
α
IF D2≠NULL_RECORD THEN D1←D2
ELSE IF D3≠NULL_RECORD THEN D1←INVERSE_DIMENSIONS(D3);
β
ELSE
α
D1←NEW_RECORD(DIMENS_EXPONENT);
redefine xx(temp)=[DIMENS_EXPONENT:temp[D1]←DIMENS_EXPONENT:temp[D2]-
DIMENS_EXPONENT:temp[D3];];
BASIC_DIMENSIONS;
β;
RETURN(D1);
β;
BOOLEAN PROCEDURE CHECK_EXP_TYPE_DIMENS_PROG(INTEGER DESIRED_EXP_TYPE;
RPTR(DIMENS_EXPONENT) PTR;
STRING ERROR_MESS);
α
CHECK_DIMENSIONS_PROG(ERROR_MESS,PTR,EXP_DIMENS);
IF EXP_TYPE=DESIRED_EXP_TYPE THEN RETURN (TRUE) ELSE RETURN (FALSE);
β;
! check_entry,insert_entry into tables;
RPTR (ANY_CLASS) PROCEDURE CHECK_ENTRY (STRING S; INTEGER TABLE_TYPE);
α
RPTR(ANY_CLASS)R1;
CASE TABLE_TYPE OF
α
[ID_TYPE_TABLE] α R1←SYMBOL_TABLE[HASH(S,ID_HASHER)];
WHILE R1≠NULL AND ¬EQU(S,ID_LIST:NAME[R1]) DO R1←ID_LIST:NEXT[R1];
β;
[array_TYPE_TABLE] α R1←array_SYMBOL_TABLE[HASH(S,array_HASHER)];
WHILE R1≠NULL AND ¬EQU(S,array_LIST:NAME[R1]) DO R1←array_LIST:NEXT[R1];
β;
[procedure_TYPE_TABLE] α R1←procedure_SYMBOL_TABLE[HASH(S,procedure_HASHER)];
WHILE R1≠NULL AND ¬EQU(S,procedure_LIST:NAME[R⊃]) DO R1←procedure_LIST:NEXT[R1]3
β;
[MACRO_TYPE_TABLE] α R1←MACRO_TABLE[HASH(S,MACRO_HASHER)];
WH@∪→∀A$b↔9+→1∧
:⊃↓*⊗FUE→26ε≥∩<bI~5#T_K5∪
U∀∧$z
&∃|L_:$yDβ∩4jGSQ6
KtL7'1"B" 7c"C!+s00j)f∩3C 00tIs∃⊗4λS∃⊂0IH4εFEαDA⊂) o`
ACRO_STACK_TOP;
WHILE B⊃≠NULL AND #*!&Q≠β
%≡1→%'(u∪⊃7∪βπI≡1' ¬π⊗u→%' 1¬"JnI
ju$Q!⊂HLIt¬∪
yX∀
∀pε∀jH0rnJ:⊂0rc ⊂∧g%Vi_n@;
↓ IF R1≠NULL_R@ π∨IλA)⊃∃_A$c⎇≠βπ∀xbNR ~-j2M~PbBαJ%@:L7 ≥CE β;
[D@∪≠∃_
N→yaE%~λQE$_)D-hβ"B!⊂H∀@_Wb MEL¬&!$
2⊗β9∧
≤α
∀eI10
)∩aH$ Td"i)];
W@⊃∪1
A$bm≥+→_↓β⊂~⊃)αεF*BM $I→T,u3λUE∧yhTu#)h∀l-αt@_WTP"'H)_ob∩d¬ENS_EP⊃!=≥β≥(i≥⊗bαK5∪
Tεc!!" c!! nc!
Q0
*T'∀)λJ]FE↓NFAεE∀(*) (AN@2aβ⊂∩ε≥→%αBα)t≤,JZ$*∧α3ThZU "S*),P
)j)$S π S; IN@)∃∂ $AQβ¬→
a)3!
l~∃%!Q$Qβ≥d1π2
~M%α∃⊃E":αYDaE(X4⎇∀E∃∪Xh !P@*T⊂
)
g →_AH β'LRA$bβYα&:αHT<-$ ∀t⊃6≥CE!`iQP* a∪"L",T ¬ OF
↓α
[@∪λa)3!
a)β¬→∃:∩∧~(∩∪∪ ↓%$b{9+⊃_E∩⊗∞>∀!αRλYb¬∪≠yd-9λ∧Q(9βi"∧∩bλ&$Th⊂ ELSE R1←RRDr~∧∩%∪λ "dJNQjt*bRn⊃
v}NLj
>0β
D ∀H[4L@Q⊃6 y⊂4r¬
hε$bε$ id⊃i∀n@;
∩∪%λ12M~Qj~ j⊗nI
j}MlhP$&NLj
>⊂β
D ∀H[4L@Q⊃6 [tL ≥CEDdQ⊂αdg∩j ALIZE THEN
α↓∪λ "dJNQjd
NBn⊂ε∃m⎇Iz↓DLDεc!↓ "2(B⊂ε$iU≥!&'⊂eHλLET@ _Dz_b∩,2:nI
j}
2|~,bHZd,c1Q HH~
U!Dα1ε
λ1q*
&*.`⊂∀*j_ID_@→∪9
Q$bαId4λHH&@$zβ∧L%z '8⊃0f @*f`∨DEC⊂⊃≥U~Vbvα
l4PH$
lhP4*@<≡',> *⊗h"L*⊂a""nBA
IF RR10≠≥U→_ "α(T @tQ⊂∃$"g R1P∨≥∃( bJ,~6J⊃F CKπβ∪∧dM:@
$λ3∀q$
L7tJ&,¬FEαDpy9_|L&$Tj≥'"V*-a1][array_@'e≠¬∨_a)β¬→⊃3∪≥ ∃17"
~!"Md∧↔.X8 L∩ id"T∀jP≠
λ∧∩βCI` πdβ DM≥E)d @10
i nh∂S;
↓ @¬aeC@IBNf6∀z0bR ∩2⊗@9→d$-α∪7j&,¬FEαDdc⊂↓dg$j∩`f$m⊃P*$"Sαλ
(HH$ β∂∪@⊗∂⊂ε∪ ~u
Sλ~u⊗tF≠5u∪jβ_<\L∨,¬FEαD@py≤αay11∪'(U →∨π⊗a→β- 01∨ 1⊃
≥]⊃Fv@x)D`8pf∪λZβ"f
CEDDT*j 0\90p→_PAGE(R1);↓!+(1¬aeC@IB2&:*BIE%Xh ⊂H⊃_
↑∧∧0y≤αay←R1;abray_DE@ε1:αYUn∂.,↔IDHX!DuYP
f↔hnaQ@∧DANβ
∀~)0∂CK|∧6.≥<Yβ
⊗4⊃#
⊂0Sλ[ ∧AεBα ∪∪_A%$bβj0∃,IC¬∀0stHD∃∩⊃)@:NAME[R1]←S;
procedure_SYMBOL_TABLE[INDEX]←R1;
IF ¬INITIALIZE THEN
α procedure_LIST:LAST[R1]←TOP_procedure;
procedure_LIST:BLOCK_LEVEL_OF_DEFN[R1]←BLOCK_LEVEL;
PUT_procedure_PAGE(R1); PUT_procedure_LINE(R1);
top_procedure←R1;procedure_DEC_NUM←procedure_DEC_NUM+1; β;
β;
[MACRO_TYPE_TABLE] α
IF RR1=NULL_RECORD THEN R1←NEW_RECORD(MACRO_LIST) ELSE R1←RR1;
MACRO_LIST:NEXT[R1]←MACRO_TABLE[INDEX←HASH(S,MACRO_HASHER)];
MACRO_LIST:ID[R1]←S;
MACRO_TABLE[INDEX]←R1;
IF ¬INITIALIZE THEN α MACRO_LIST:LAST[R1]←TOP_MACRO;
TOP_MACRO←R1; MACRO_DEC_NUM←MACRO_DEC_NUM+1; β;
β;
[MACRO_IN_MACRO_TYPE_TABLE]
α
RPTR (macro_list)r2;
IF RR1=NULL_RECORD THEN R2←NEW_RECORD(MACRO_list) ELSE R2←RR1;
r1←new_record(macro_stack);
MACRO_STACK:STACK_LINK[R1]←macro_stack_top;
macro_stack:list_ptr[r1]←r2;
MACRO_STACK_TOP←R1;
macro_list:id[r2]←s;
R1←R2;
β;
[DIMENSION_TYPE_TABLE]
α
IF RR1=NULL_RECORD THEN R1←NEW_RECORD(DIMENS_EXPONENT) ELSE R1←RR1;
DIMENS_EXPONENT:NAME[R1]←S;
DIMENS_EXPONENT:NEXT[R1]←DIMENS_TABLE[INDEX←HASH(S,METRIC_HASHER)];
DIMENS_TABLE[INDEX]←R1;
IF ¬INITIALIZE THEN α DIMENS_EXPONENT:LAST[R1]←TOP_DIMENS;
TOP_DIMENS←R1; DIMEN_DEC_NUM←DIMEN_DEC_NUM+1; β;
β
β;
RETURN(R1);
β;
! expression evaluation routines;
RCLASS EXPR (STRING BODY; INTEGER TYPE; RPTR(DIMENS_exponent)DIMEN; RPTR(EXPR)NEXT);
SIMPLE INTEGER PROCEDURE MATINX(INTEGER VAL; INTEGER ARRAY A; INTEGER LB,UB);
α INTEGER L,M,U;
L←LB; U←UB;
DO α M←(U+L)/2;
IF A[M]=VAL THEN RETURN(M)
ELSE IF A[M]>VAL THEN U←M-1
ELSE L←M+1;
β UNTIL L>U;
RETURN(0);
β;
define #ntype=10;
SIMPLE INTEGER PROCEDURE FUNC(INTEGER ARRAY T);
α INTEGER I,R; R←0;
FOR I←0 STEP 1 UNTIL 4 DO R←R*#NTYPE + T[I];
RETURN(R);
β;
RPTR (EXPR) PROCEDURE MK_EXPR
(STRING BODY; INTEGER TYPE; RPTR(DIMENS_EXPONENT)DIMEN);
α RPTR(EXPR)X; X←NEW_RECORD(EXPR);
EXPR:BODY[X]←BODY; EXPR:TYPE[X]←TYPE;
EXPR:DIMEN[X]←DIMEN; RETURN(X);
β;
! OP, OP_TYPE,RES_TYPE,ARG1, ARG2, ARG3, DIMENR, DIMEN1, DIMEN2, DIMEN2,RESULT ;
REQUIRE "⊂⊃⊂⊃" DELIMITERS;
DEFINE OPERATIONS = ⊂
XX("¬", NOT_X, #SC,100,#SC, 0, 0, NIL_D, NIL_D, NIL_D, NIL_D, NOT)
XX("≡", EQV_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, EQV)
XX("∧", AND_X, #SC,120,#SC, #SC, 0, NIL_D, NIL_D, NIL_D, NIL_D, AND)
XX("∨", OR_X, #SC,120,#SC, #SC, 0, NIL_D, NIL_D, NIL_D, NIL_D, OR)
XX("⊗", XOR_X, #SC,120,#SC, #SC, 0, NIL_D, NIL_D, NIL_D, NIL_D, XOR)
XX("=", SEQ_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SEQ)
XX("≠", SNE_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SNE)
XX(">", SGT_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SGT)
XX("<", SLT_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SLT)
XX("≥", SGE_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SGE)
XX("≤", SLE_X, #SC,120,#SC, #SC, 0, NIL_D, ANY_D, SAME_D, NIL_D, SLE)
XX("UNIT",UVECT_X, #VT,100,#VT, 0, 0,NIL_D,ANY_D, NIL_D, NIL_D, UVECT)
XX("AXIS",AXIS_X, #VT,100,#RT, 0, 0,NIL_D,ANGL_D, NIL_D, NIL_D, AXIS)
XX("POS",POS_X, #VT,100,#FR, 0, 0,DIST_D,DIST_D,NIL_D, NIL_D, POS)
XX("POS",POS_X, #VT,100,#TR, 0, 0,SAME1_D,ANY_D,NIL_D, NIL_D, POS)
XX("ORIENT",ORIENT_X, #RT,100,#FR, 0, 0,ANGL_D,DIST_D,NIL_D, NIL_D, ORIENT)
XX("ORIENT",ORIENT_X, #RT,100,#TR, 0, 0,ANGL_D,ANY_D, NIL_D, NIL_D, ORIENT)
XX("INV",RINV_X, #RT,100,#RT, 0, 0,ANGL_D, ANGL_D,NIL_D, NIL_D, TINV)
XX("INV",RINV_X, #TR,100,#TR, 0, 0,SAME2_D,ANY_D,NIL_D, NIL_D, RINV)
XX("MODULUS",SABS_X, #SC,100,#SC, 0, 0,SAME1_D,ANY_D,NIL_D, NIL_D, SABS)
XX("MODULUS",SABS_X, #SC,100,#VT, 0, 0,SAME1_D,ANY_D,NIL_D, NIL_D, VMAGN)
XX("MODULUS",SABS_X, #SC,100,#RT, 0, 0,ANGL_D,ANGL_D,NIL_D, NIL_D, RMAGN)
XX("+", PLUS_X, #SC,100,#SC, 0, 0, SAME1_D,ANY_D, NIL_D, NIL_D, SMUL +1.0)
XX("+", PLUS_X, #SC,120,#SC, #SC, 0, SAME1_D,ANY_D, SAME_D, NIL_D, SADD)
XX("+", PLUS_X, #VT,100,#VT 0, 0, SAME1_D,ANY_D, NIL_D, NIL_D, SVMUL 1.00000)
XX("+", PLUS_X, #VT,120,#VT, #VT, 0, SAME1_D,ANY_D, SAME_D, NIL_D, VADD)
XX("+", PLUS_X, #FR,120,#VT, #FR, 0, DIST_D, DIST_D, DIST_D, NIL_D, TVADD)
XX("+", PLUS_X, #TR,120,#VT0∩G)$0∩`X∪Mβ≠
baλYβ≥d1λX∪Mβ≠
1⊂X∪≥∪01λX∪Q-β λ$~∃10 @VDX%!→+&a0X∩G→%
XbH`XG
HX∩G-PX∩`X% ∪'(aλX∪ %'(1λ0∪ ∪'P1λX∪9∪_!λ0∪)-β⊃λR~∃a0PDVλX∪!→U&10X$G)$XDd`XGQ$X∩GY(X∩`0∪'β≠∀b1λY¬≥21λ0∪'β≠∀1λX∪9∪_ ""`&BZ "⊃$4PH$$4UBa! j⊃0&6LrVLbBaεN
c AA⊃≥~
0%α`%A0M~ε6∃ B⊃2εuHb⊃A→dLaλE@Lt→C∧"`~9d,:⊃Q%EB∧%R∩`→Y∀u-3 αb≥85C ∪¬D5≤~A∀5≤~A⊗α`M8→T+ λAD u⊃λB`M8→T)DEA∀tLAλB`M::T∩Hβ"V ¬λK(EA323JZf⊗β∧:U &ελε⊃k∃⊗∧X⊗αX⊗∧iPfbP⊃_D,ANY_D _∪9∪_ " `&:&aB⊃0&5~V αtJ2Z⊗≥!↓$4UBa! j⊃0&6LrVLbBa∞ZQc IA⊃≥2Q0%≥2Q0%α`&Nεl)Db⊃d
:db ¬@M≤→XQD"A→dLaα⊃ ↓~Tu0E⊃"V⊗¬∧K(C↓→23U*3⊗ λhjQ+ && λqJ%α(uJEα, ↓_∩4uβλ α1 ~u " ∧b$iU "⊗∧S$f∧" ∧j+)Ua∀FE⊗,∀⊃⊗H⊗∧fdS*iL, ⊃j),120,#TR, #VT, 0, SAME1_D1β≥2D!0&N j∀b⊃`J2&0βλB`MJj5,∩⊃Q hU ¬ααR%A∃$LXZ1EBD:4~@ ,L¬Dtpk↓∀tpk↓⊗ α3*Y∃ " ∧`g,F"⊂ ANY_D NIL_D, SMUL)
XX("*", TIMES_X,#VT0bd`X
'εH∩
-(X∩@X∪≠ 1(1λX%β≥2⊃⊂X∪β≥d1λ@0Lr&0@λA@M≥iZTbHQ+¬BB%$"`MI→T-→ ↓B≥∃EF# αβλuJEα(th5α, ↓→53∃βλλε∧`S,L"εα`g →_D, NIL_D, SVMUL)
XX("*" T@∪≠∃&10X
-(XbH`XG
PX∩G-PX∩`X%≠+→(aλX∪β921λX%β≥"⊃⊂X∪≥∪01λ@0M2∞J>≥→$4*EA! )⊂¬@M$α31*3⊗ λjj → ⊗⊃a* ∧Qk* ∧X⊗∧T`fbYε"⊂ ANGHλ1λα`&ε:β∪∧"`→i∀aDEA∃∃4XYBHh+ αB∩$!@M$α31*3⊗ λj* → ⊗⊃`∩T, #@%PX∩`X%β∃∂_aλX∪β9∂⊂⊂b ¬@L hyAD"βα3I→∧∧", RRMUL)~∃a0PDTλX∪)∪5 &!⊂αaε@5EF∪∪αβλu
%α(uJEα, ↓~p31&∪⊃ ⊂)k&⊃⊗α`g →_D, NIL_D, TVMUL)
XX("*"0∪)&l*Lbab~~J∃c IAD:E∩`∀8e∩`⊗¬@L$~:ADαβα1 ~u " ∧b$iU "⊗∧SαIL1⊂X∪))5+_@$hRba!⊂¬"∩`~I∀l-3 αb≥J ε⊗L λjJKα(jJKα$¬A4p3(V&⊃⊗⊂dεY1⊂X∪'β5
1λX%_
&0βλB`MJIU,bα#"K λλS(≠λK∪(≠ε⊂ , #SC,120,#SC _∩
'εX∩@X∪'β5
b1λαbε*dβλB`M8→T)DEA∀`)3 " ∧f`l
FE,,
⊃&dgλ⊗&dgε,∩⊂⊃TaV_@20,#CC, #SC, 0, SAME1_D →β921λX%'β≠
aλX∪≥%_1λX%≠∪≤R4∃10P ∪,D1 ∪,1`X@G' Xbd`0G'εX$@∞N
`IA0&$JR&⊂βλBd hε&λEα03K∪⊃ α)@$f_D, DIV)
XX("MOD",MOD_X$ #SC,1∩0,#SC, #SC, 0, SAME1_D →β921λX%'β≠
aλX∪≥%_1λX%≠∨λR4∃10P ∪≥(D1∪∃(⊃`X@Gπ Xb``0G'εX$`X∩`0∪'β≠∀b1λY¬≥21λα`&:&aB⊃0&tJ0b⊃`J& 5E⊃PPhαH ⊂≠7z2P→5v6 /wing↓SfAB↓WYkI≥rAoCdAP∨→εkπ/'v9β@2∞}'"εdπRαG.iW.b¬
w⊗N]nBε2∀∞bJβ1Q%EB∧*u∃"%Ju∃! ↓∀uU⊗ _X⊗⊃U*⊗∧QT*⊗∧X ∧i`fQXL",AJYλD, ANGL_D, L¬∪_D!0&J4jV1$hP4*bβ¬α#(Kα"β&⊂ λK∧Q`∀R,120,#BR, #BR, 0, DISP_D0∪ ∪'P1λH∪⊃∪'(D!0&:L`b⊃0L2R>→Hh*baB⊂e 0Idb`λ`%∞R⊂¬C ∪#FR, 0, DIST_D, DIST_D, DIST_D, NIL_D, FTOF)
XX("→", ⊂→_X⊃, #TR,120,#TR, #TR, 0, DIST_D, DIST_D, DIST_D, NIL_D, FTOF)
XX(".", VDOT_X, #SC,120,#VT, #VT, 0, MULT_D, ANY_D, ANY_D, NIL_D, VDOT)
! XX("CONSTRUCT",CONSTRUCT_X,
#TR,123,#VT, #VT, #VT, SAME1_D,ANY_D, SAME_D, SAME_D, CONSTR);
XX("CONSTRUCT",CONSTRUCT_X,
#TR,123,#VT, #VT, #VT, DIST_D, DIST_D, DIST_D, DIST_D, CONSTR)
XX("SQRT",SQRT_X,#SC,100,#SC, 0, 0, SQRT_D, ANY_D, NIL_D, NIL_D,⊂SSBRTN 1⊃)
XX("SIN", SIN_X,#SC,100,#SC, 0, 0, NIL_D, ANGL_D, NIL_D, NIL_D,⊂SSBRTN 2⊃)
XX("COS", COS_X,#SC,100,#SC, 0, 0, NIL_D, ANGL_D, NIL_D, NIL_D,⊂SSBRTN 3⊃)
XX("ASIN",ASIN_X,#SC,100,#SC, 0, 0, ANGL_D, NIL_D, NIL_D, NIL_D,⊂SSBRTN 4⊃)
XX("ACOS",ACOS_X,#SC,100,#SC, 0, 0, ANGL_D, NIL_D, NIL_D, NIL_D,⊂SSBRTN 5⊃)
XX("ATAN2",ATAN2_X,#SC,120,#SC, #SC, 0, ANGL_D, ANY_D, SAME_D, NIL_D,⊂SSBRTN 6⊃)
XX("LOG", LOG_X,#SC,100,#SC, 0, 0, NIL_D, NIL_D, NIL_D, NIL_D,⊂SSBRTN 7⊃)
XX("EXP", EXP_X,#SC,100,#SC, 0, 0, NIL_D, NIL_D, NIL_D, NIL_D,⊂SSBRTN 8⊃)
XX("/", SDIV_X, #SC,120,#SC, #SC, 0, DIVID_D,ANY_D, ANY_D, NIL_D, SDIV)
XX("/", SDIV_X, #VT,120,#VT, #SC, 0, DIVID_D,ANY_D, ANY_D, NIL_D, VSDIV)
XX("↑", STOS_X,#SC, 120,#SC, #SC, 0, NIL_D, NIL_D, NIL_D, NIL_D, STOS)
! XX("↑", EXPON_X,#SC, #SC, #SC, UNKN, ANY, NIL, $STOS) ;
! XX("SCALAR",⊂#sc+opc⊃, $SMAKE, #SC, 0, 0,SAME1,ANY,);
XX("VECTOR",⊂(#VT+OPC)⊃,#VT,123,#SC,#SC,#SC, SAME1_D,ANY_D, SAME1_D,SAME2_D, VMAKE)
XX("ROT",⊂(#RT+OPC)⊃, #RT,120,#VT, #SC, 0,ANGL_D, NIL_D, ANGL_D, NIL_D, AXW_ROTN)
XX("FRAME",⊂(#FR+OPC)⊃, #FRE,120,#RT, #VT, 0,DIST_D, ANGL_D, DIST_D, NIL_D, FMAKE)
XX("TRANS",⊂(#TR+OPC)⊃, #TR,120,#RT, #VT, 0,SAME2_D,ANGL_D, ANY_D, NIL_D, TMAKE)
⊃;
DEFINE #SC=SCALAR_VALUE, #VT=VECTOR_VALUE,#TR=TRANS_VALUE,#FR=FRAME_VALUE,#RT=ROT_VALUE,#FRE=FRAME_EXP_VALUE;
DEFINE SAME1_D=1,SAME2_D=2,SAME3_D=3,MULT_D=4,DIVID_D=5,ANGL_D=6,NIL_D=7,ANY_D=8,SAME_D=9,DIST_D=10,SQRT_D=11;
DEFINE XX_MAX=0;
DEFINE OPC=OP_COUNT;
DEFINE OPERATOR_COUNT=0;
REDEFINE XX(OPQ,OPXXX,#TYR,OPR,#T1,#T2,#T3,#DR,#D1,#D2,#D3,STR) =
⊂ REDEFINE OPERATOR_COUNT=OPERATOR_COUNT+1;
REDEFINE NEW_TOTAL= (((OPXXX*#NTYPE+#T1)*#NTYPE+#T2)*#NTYPE+#T3)
*#NTYPE;
IFC XX_MAX>NEW_TOTAL THENC
REQUIRE CRLF&"DISORDERED "&OPQ&CVS(OPXXX) MESSAGE;
ELSEC
REDEFINE XX_MAX = NEW_TOTAL ; ENDC⊃;
OPERATIONS;
REDEFINE OPERATOR_COUNT=0;
REDEFINE XX(OPQ,OPXXX,#TYR,OPR,#T1,#T2,#T3,#DR,#D1,#D2,#D3,STR) =
⊂ REDEFINE OPERATOR_COUNT=OPERATOR_COUNT+1;
REDEFINE NEW_TOTAL= (((OPXXX*#NTYPE+#T1)*#NTYPE+#T2)*#NTYPE+#T3)
*#NTYPE;
NEW_TOTAL, ⊃;
PRELOAD_ARRAY(OCODE,OPERATIONS,INTEGER,1,OPERATOR_COUNT);
REDEFINE XX(OPQ,OPXXX,#TYR,OPR,#T1,#T2,#T3,#DR,#D1,#D2,#D3,STR) =⊂"STR",⊃;
PRELOAD_ARRAY(SCODE,OPERATIONS,STRING,1,OPERATOR_COUNT);
DEFINE #NDTYPE=20,#NOTYPE=1000;
REDEFINE XX(OPQ,OPXXX,#TYR,OPR,#T1,#T2,#T3,#DR,#D1,#D2,#D3,STR) =⊂
REDEFINE XX_TEMP= ((((#TYR*#NDTYPE+#DR)*#NDTYPE+#D1)*#NDTYPE+#D2)
*#NDTYPE+#D3)*#NOTYPE+OPR;
XX_TEMP,⊃;
PRELOAD_ARRAY(INFO,OPERATIONS,INTEGER,1,OPERATOR_COUNT);
PRESET_WITH "SCALAR","VECTOR","ROT","FRAME","PLANE","TRANS","EVENT","ATOM","WORLD","LABEL";
STRING ARRAY DTYPE[1:10];
PRELOAD_WITH EQV_RES,OR_RES,AND_RES,ORDER_RES,ADD_RES,MULT_RES,WRT_RES;
INTEGER ARRAY RESCL[0:6];
! P_EXP2_BASIC, OPCODE, ERROR HANDLER ;
BOOLEAN PROCEDURE P_EXP2_BASIC;
α RPTR(EXPR)$$1; LABEL DONEP;
RPTR(DIMENS_EXPONENT)
procedure CHECK_DIMENSIONS(STRING S; RPTR(DIMENS_EXPONENT) D1,D2);
α RPTR (DIMENS_EXPONENT) R1;
R1←CHECK_DIMENSIONS_PROG(S, D1,D2);
IF GLOBAL_MODIFIED=TRUE THEN α GLOBAL_MODIFIED←FALSE;GOTO DONEP;β;
RETURN(R1);
β;
BOOLEAN PROCEDURE CHECK_EXP_TYPE_DIMENS(INTEGER DESIRED_EXP_TYPE;
RPTR(DIMENS_EXPONENT) PTR;
STRING ERROR_MESS);
α BOOLEAN B1; B1←CHECK_EXP_TYPE_DAMENS_PROG(DESIRED_EXP_TYPE, PTR ERROR_MESS);
IF GLOBAL_MODIFIED =TRUE THEN α GLOBAL_MODIFIED←FALSE;GOTO DONEP; β;
RETURN(B⊃);
β;
RPTR(ANYλCLASS) PROCEDURE ERROR(INTEGER I; STRING S);
α RPTR(ANY_CLASS) RDv~∃∂1≠¬β_a¬βπ↔U!?)%U
vAdβ
}⊗J∀zHb
~&
"JbM%LhR&→α<b6
εaB6>∩L2&⊗⊃βiαRJ,)αR",q α<*PbR|Z⊗9@4λtd|(→ADlxI∀4LXKt4 J8SXh!⊃⊂HJλyu$zλItt-π4≠XQ*$-%X)bE∪∃↔0hP71PPh!Q hU*
E∩αλ[¬¬∩∀
¬∀|8XE-∀T u∧≤xHRDLhHT<-$ uαdh~$=≠4
%¬%%λUE¬%~"KXQ M≥J)∀t~
72∧Lh¬⊃(x4H∩%I3Q⊃+πc"B**∃∀Jλ→V"⊂iH4tj$λ,+∀F↔c"B**∃∀JλI313J3⊃2∀ yQ3U¬∀⊂4TH≠(⊃⊗f↔Lw+λ[l.LkWc"B*:∀R3Ht⊂4TH≠(∀l+6.M↔'1"B2)j⊃1q*$⊂4TH≠(⊃⊗fπM↔#
F6h.F;.c"A→3Q⊃(x4H∃ ~∪tKλI34K
K4⊃4G1"B2)j⊃1q*$⊂4TH≠(⊃∩)Y3QSk6.Lw'1"B2)j⊃1q*$∩Nc!! B5 6↔7sjπh∀D+zNhβ!!1StD 7l(
:⊃4λε∀∃3U →λ
λλIh⊃⊗i≠7l∞aQA"B(itH∩+v(∀uλZλ ⊂∃g*$fλ' i#TP&dgλ~⊂"'CE∧DAλ$c⊂∀∃-dnoQl():TYPE[R1])=0
α T@EN RE@)U%≤Q≠,1 1!HQ≥+→0X`I≥U→_1%∃π↔%λ$Rv~∀$∩@A$β
}⊗b¬⊃j:⊗E"fIFhπ2≠1Q hP→_bαD→hD-EyX∃$Li¬∧5,h5¬"JIx4|$UF∩d⎇λZ$
$z#∧≤@u3U¬∃/,λ
I⊃3C!!" @∧
u∀R)hh∀k
6.h∀kx∃⊗4λ[u⊗`_WnX
FOR I← 2 STEP 1 UNTIL NARGS MIN 4 D@≡~(∩∩∪∪_A)7∪t6`A)! ≤A'⎇&LDXDE )e! 7)m∪;:v4∀∩∪∪_A∨ 9= 1π∨U≥(A)! ≤A&E?↔! Iβ)∨%M7∨!:↓ →'
4∀∩∩∪Lc? )e! 7∨@[∨ 1
∨+≥ tv~∀∩% %%∨HPj``@XE∨!∃%β)∨H←@≠Wv≠S'?r↓ ~M
1 α∞ r:>Q¬"ε.∃∧zB⊗J r∩M?∂∪∨W7.sSM↓⊂h($$J2M~∞∀b→→
≤z:R&u*∃α↑Lb1α≡M2∃α:,b1α⊗EαJ⊗N≤J>) KX4($M∩⊗RV∀q"6,D*bBIDrV21c↓2:Vd`bJ⊗≤zJ⊃%KX4($H→l4(hP&&}Lr~>nLr∩⊗Bhπ0hP→+rα≤izEM∧W1PPMK~∧⎇∃y∀∧l|D #XL≠t∧J∧I~b∧S1Q LUt9d%%~λSXh!_DLl→hd⎇[9[tJ∧YxB∧S4 ∃|JλI∃2∧'1PPLI→TLti{3∃my∀∧l|D #Z∧≠y∩∧$~d∧SXQ!∀$LY→d4⎇6≠U|J Yt"∧'4∧M|∀λDM2 '0hP→+r≤tJK∃∧+αc"A_⊂∧fi↔dP&gQ⊂%≥@∃,h"i↔dP"$U⊂%≥FBε@
T1[1]←TYPOR DIV 100;
T1[2]←(TYPORDIV 10)MOD 10;
T1[3]←TYPOR MOD 10;
R1←R;S←NULL;
FOR I←1 STEP 1UJTIL NARGS DO
↓IF R1 NULLλRECORD THEN
↓ α
↓ D[I]←EXPR:DIMEN[R1]+
S1[I]←EXPR:BODY[R1]0⊗~(∩∪$c⎇ 1!$i≥ 1 m$c:V4∀∩βπ¬'
A %≠∪≥
=7∪:A= ~∀∩$∩∧4PH$&n rdb∩hH&⊗NMj}∩nMil4(HH&nN j∀b∩hJ∞"⊗≤Xb∩→XTu≤α3sJ5λJJE%HK⊃ 97+⊃+977q+9+(λnJ]FE∧BDmb$Tj ".H⊂∧ad⊃aeL"∩dbg)Rg`∞S(NULL,D[I],DISDANCE_DIIENS);
[ANGL_D] CHECK_DIH ≥M∪∨:~B:V2bb∩n&jbε*≡d(b∩→XTu~↔1PPH⊃≠4dL@ε⊃ Q 0rλXrf⊃ →αbg)Rg`∞S(NULL,D[I],L¬∪_D"&&⊗u→$4λHH$
lhP$$
∧*2N∃∧"> 4W1PPh!_4
≤TλDLm$ t0H!⊃⊂⊂@"B"+i`fbLL".DQXh∂D[1]0⊗~(∩∪7≤
6∃HβλEhLT∧7hKlW ≥CE [SAME3_D] E1←D[∪];
[M@+1(1 :%
c/≠U→)∪!121 ∪5 ≥'∪=≥&@"%YFu2%YJu%Xh $&\"&Z&!B∩T_V∃|$~i∀$)λI∀l,h9∀|@Tj⊃ 64εV"⊗Y.T]CE [DISD_DY∪
E? ∪'Qβ⊂~∞)B∩ε6,rMl∀PH&nεt:0b∩hJ∃F@x→d<@⊃"⊃ →αbg)NFA∧DVβNIL_DP∩$L!F}i→AD∧α31)@)YFEαDa`∪PRT⊂⊃ t∪
c?M#%(D"&,Yj4L@pπ!T⊃-Xn@)8ε~(HJε $∧q(λZTStEε,λλ_ ⊗⊃( T)bi1i)'iλ$g⊂"∩d¬ENSI@∨9∧"ε@$X∧S)_β j$Sβ@ D∩RN(MK_EXPR("( $"&SCODE[INDEX]&S&")",TYPER,E1));
β;
! exp,bfact,bterm,aexp,term,factor;
IFC FALSE THENC
EXP E: BFF | BFF ≡ BFF
BEFACT BFF: BF { OR BF }
BFACT BF: BT { AND BT }
BTERM BT: AE | AE <REL> AE
AEXP AE: {+|-} T {+|- T }
TERM T: F {*|/ F}
FACTOR F: PF or PF↑PF
PFACTOR PF: ( E ) or | E | or func(E,E,E,..) or <constant> or <id> or ¬ PF;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE EXP;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BEFACT;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BFACT;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BTERM;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE AEXP;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE TERM;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE FACTOR;
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE PF;
! EXP E: BFF | BFF ≡ BFF ;
%%% RECURVISE RPTR(EXPR) PROCEDURE EXP;
%%% α RPTR(EXPR)$$1,$$2;
%%% $$1←BEFACT;
%%% IF TYPE_OF_RES_WORD = EQV_RES THEN
%%% α INTEGER I; I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1]←BEFACT;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETURN($$1);
%%% β;
%%%
%%% ! BEFACT BFF: BF { OR BF } ;
%%%
%%% RECURSIVE RPTR(EXPR) PROCEDURE BEFACT;
%%% α RPTR(EXPR)$$1,$$2;
%%% $$1←BFACT;
%%% WHILE TYPE_OF_RES_WORD=OR_RES DO
%%% α INTEGER I; I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1] ← BFACT;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETURN($$1);
%%% β;
%%%
%%% ! BFACT BF: BT { AND BT } ;
%%% RECURSIVE RPTR(EXPR) PROCEDURE BFACT;
%%% α RPTR(EXPR)$$1,$$2;INTEGER I1,I2;
%%% $$1←BTERM;
%%% WHILE TYPE_OF_RES_WORD=AND_RES DO
%%% α INTEGER I; I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1]←BTERM;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETURN($$1);
%%% β;
%%% ! BTERM BT: AE | AE <REL> AE ;
%%% RECURSIVE RPTR(EXPR) PROCEDURE BTERM;
%%% α RPTR(EXPR)$$1,$$2;
%%% $$1←AEXP;
%%% IF TYPE_OF_RES_WORD = ORDER_RES THEN
%%% α INTEGER I; I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1]←AEXP;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETURN($$1);
%%% β;
%%% ! AEXP AE: {+|-} T {+|- T } ;
%%% RECURSIVE RPTR(EXPR) PROCEDURE AEXP;
%%% α RPTR(EXPR) $$1,$$2; INTEGER I;
%%% IF TYPE_OF_RES_WORD = ADD_RES THEN
%%% α I←SPECIAL_INFO;
%%% GET_TOKEN; $$1←TERM;
%%% $$1←OPCODE(I,1,$$1);
%%% β
%%% ELSE $$1←TERM;
%%% WHILE TYPE_OF_RES_WORD = ADD_RES DO
%%% α I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1]←TERM;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETURN($$1);
%%% β;
%%% ! TERM T: F {*|/ F} ;
%%% RECURSIVE RPTR(EXPR) PROCEDURE TERM;
%%% α RPTR(EXPR) $$1,$$2; INTEGER I;
%%% $$1←FACTOR;
%%% WHILE TYPE_OF_RES_WORD = MULT_RES DO
%%% α I←SPECIAL_INFO;
%%% GET_TOKEN; EXPR:NEXT[$$1]←FACTOR;
%%% $$1←OPCODE(I,2,$$1);
%%% β;
%%% RETUBN($$1);
%%% β;
%%% ! FACTOR F: PF or PF↑PF or PF WRT PF or PF→PF ;
%%% RECURSIVE RPTR(EXPR) PROCEDURE FACTOR;
%%% α RPTR(EXPR) $$1,$$2; INTEGER I;
%%% $$1←PF;
%%% IF TYPE_OF_RES_WORD = WRT_RES THEN
%%% α I←SPECIAL_INFO; GET_TOKEN;
%%% ! Following is a kludge because v WRT f goes to (RVMUL (ORIENT f) v);
%%% IF I≠WRT_X THEN EXPR:NEXT[$$1]←PF¬
%%% ELSE α $$2←PF;
%%% EXPR:NEXT[$$1]WOPCODE(ORIENT_X,1,$$2);
%%% β;
%%% $$1WOPCODE(I,2,$$1);
!%% β;
%%% RETURN($$1);
%%% β;
%%% ! PFACTOR PF: ( E ),
%%% f(E,E,E,..)
%%% <constant>,
%%% <id>,
%%% ¬ PF;
%%% RECURSIVE RPTR(EXPR) PROCEDURE PF0⊗~(JJJ∩λ∪%!)HQ 1!HRHHb0HHdX⊂HfvA%≥) ∂∃$A∩Y$dv~∀$∩~)*)∀$&≤
N∃α%JB∀b|0bR≡\*9α>0h)∃∃(H$$λHh)¬∃(H$&nu*6⊗JL_bR>\*:t$hQ∃∃∀HH$$λhQ∃∃∀HH$%⊃#
}6,D*bBIE">.⊗rbN∞εd
HbZ bV∃2tJ0b∩Lj⊗:MKX4)∃*($$$L:⊗Pb$z.⊗9Xh)∃∃(H$$$≠X4)∃*($4)*)∀$$MZ&⊂b$z.⊗:hh)∃∃(H$$$⊂h)∃∃(H$$%"!F}6YB⊗bB∩BR>.,q2&⊂E"fB∃dJ⊂b2M~Qj∩Lj⊗:n$z.⊗8EαRJuKX4)∃*($$$L:⊗Pb$z.⊗9Xh)∃∃(H$$$≠X4(4R)∃∀$HJnJ⊗≤*JZ⊗!BR>.,rt4)*)∀$$HJ∞εN*αRfB)B>_b∀*Lb↑⎇∩⊃α>0h)∃∃(H$$$⊂h)∃∃(H$$&↑ Lc⊗+Nt4R)∃∀$HH$$ ∧:⊗Pb$z.⊗9Z↓⊃⊃F|*bAnMzNB⊗≤Jε0bLr~=lhQ∃∃∀HH$$&L1αR>\*8m b⊂4)∃*($$$HJR"⊗rα⊗JJ⎇⊂bJ⊗T*∞A! )A1
lJN&ε$~"⊗⊃¬2⊗JQ∧∩εI1¬:&2⊃∧J:N⊗∃! $4R)∃∀$HH$&⊗e~∃α≡- bR≡\*9l4R)∃∀$HH$%⊃#
}.B≤z∩∃"JaE1⊃# %l4R)∃∀$HH$$
Xh(4)*)∀$$HJo≠Wv_cK↔≥h4)∃*($$$HH α&zαNB⊗≤Jε0BLr~=lhQ∃∃∀HH$$&<*PbR|Z⊗9@1Q"**Q⊃⊂HH→_b¬$y8TaZ%∧ hRTTPHH⊃⊃∃$DYd∧-∃)z!E∀Y(T≥αε⊗cαb*(U
,~(R∧dXjB¬∧~(Trb
y∀db →e≤-*D"Hh$TR(H⊃⊃⊂L,J8R∧<ZC¬$|8YcXh$TR(H⊃⊃⊂J"F+r"#≠xUEβ4 ∪∃{↔1PR*TQ⊂HH⊃~tDLHT¬$|8Ycj∩D$∧$xQ$R*(⊃⊃⊂HH⊂ λλx5ε∃ yq3Nd∧ wh[∀∞b)⊗Wr,D¬h &aQI))!⊃"""!∀ Weλ6∀∀G)Q6∃ 4 W+t j'1"I)$Q"""!⊃ nc!$))"!⊃""2(d∃∪rhYFhJ$!"I)$Q"""!∀λλλ
I⊃3HλZTStC
Q2Q(:
-F¬λS2*905⊂iλ1λ∀λ~Q3K∧
r3∪∧ 3Tq**λJ#!$))"!⊃""(∧∧λ⊃3
8(⊃q*C∃∪rhYL¬FE RRDDBDDR∩ ogh!Sb"T$K$Y⊗∩ _T]FB∩RRDBDDDANFEεE RRDDBDmr2Xv0y2F92ynCE∩RRBDDDD@⊂$oP∀h"adPfλλINFO + op_cOunt;
!%% GET1Q∨↔ ≤βX4)∃*($$$HJ&→α$z.⊗8Z⊃!λ4R)∃∀$HH$&RD*9α⊗∃∩>Hbα(TT0uαε⊗L λJ(452*(αP&"Q*⊂( T"g⊗⊂∃df&⊂∩e)bi∃⊃∀FE RRDDBD@bf∀bP#bU *'eQg_
%%% $∧2X∞HHE? "βYα%Jy l4 *)∀$$HH&↑αLb∃αR|Z⊗9@T%Bα∧IqPR))"!⊃""" $⊃q5β
⊂πebS≥P∩∩ ob`_P8ε∪∩e⎇∩d@Vα↓El4R)∃∀∧HH$$% !Jm"-BBI@)hUE%4DC∃mtDC~Kαc"DT)""!⊃"" g1 I)$Q ""!→1H∃ yq3Fd¬(C"DT)""!⊃ (λ∧∧∃∩⊃)D⊃0 )∪i ∩EJ@ π(αAEYAb∩6&Nl
R∞",!αBε∀*91α<J21αLrN⊗J ∧"HhαI)$Q"""!∀λλλλYα)bP⊃bj_TOKENl~∀JJ∀∩∩∩∩$HHc?=!π>$)"%2K⊃1⊃⊃λ¬∪Xh$TR(H⊃⊃⊂H≠1Q hRTTPHH⊃≠4⎇∧Yc¬∧
(YaE∀Z;PhRTTPHH⊃⊃⊂∩∧xZAE$βrq)Gh ε≠q0 (∞F@
%%% ↓ IF TOKEN≠ )"
%%% THEH A I%∨$⊃I ∃ πPPbl`0E≠∪'5β!π⊃∃λA!βI ≤HA]∪→1∧J0∃≤X∧U∧∀@
%%%∩∩$∩∪ →M
A∂ P1)>\*1l4R)∃∀⊃⊃⊂HH51PR))"!⊃"6sIzα ∩ES]~∀∀JJ$HH$$ ∧J}NB,~&ε0β ∀`(β']@ GET1Q≠↔ ≤βX4)∃*($$∧HI⊃#≠xUEβ1Q"**Q⊃⊂HH∀@ ε≠st⊂ix⊃*∩%F+ ↓ε∃,¬FE RRDDBDDA]CE
%%%∩∩$∪7∨$aeKg~4∀@∃∃(H$$$H⊂4)∃*($$⊃⊃∩" 7s)∪⊃0 (∀∀!ji∀"g" ⊃) fbKε@
%%% ↓ F@%¬≠
1
¬→+
Y⊃∪')β9π
1 %≠ ≥&$v~)*)∀$∧HH&≡⊗αC¬$|αq3G1 ¬∩RID@DDBA]FEβE∩RRBD@DmSdiaL∀ ¬S]
JJ$∩∩∩∪% A
)"Ry8Trb)→e≤≤→H∃∩∩⊃Q"**Q⊃⊂HH~I∧,@HC!$αRRDBDDDDI⊂∧1←MK_E@1A$PDP⊃'πβ→¬%⊃%⊂¬E≤≤→H∃⊃Eh→E,*D dLaα⊃∩)X3Tj'1 ¬∩RID@DDBDcbjε* ∂KEL∧v~∀∀JJ$HH$%↓α↓↓ hQ∃∃∀HH$$_YE≤* _b∧45*
Ip¬bg ⊃(jbT,Q∀FB⊂¬%% ↓∩∪Q⊃⊗9⊂4 ∃*($∧⊃⊃∩αα∧∧¬≥∀R3HT∀`≥FB⊂¬%% ↓↓ S←"($⊃UERY ∧v
∀∀BJ$HH$J∧∧αα∧xZAE$βrq @≥BE∩IR@ ↓ @∪ ↓)∨.,pm !⊂∧¬$DY`λλZTStC
Q2QPβT ⊂↓λεc
@λ[Y,\α⊂∀ a`
iKβ⊃αFV-∩e %Xh ∩))"!⊂ ∧D@(⊂⊂⊂"∩β α
%!% ∩$L:ε@!λ¬∪@Rbg⊂≠
λ∧@∃∃(H$∧⊃⊃∀LH⊂
,T L'cε* KDL∧p⊗NαJ$L↓Q` *∪βKEN↓)"⊗p∧4RTTPH↓ ∧DDBP⊂⊂↓αik`∪&TO@↔ 8LD@DβYα<X¬ε
Ip¬bg∞β β
λ%
J∩ ∩$⊃_Te≤T"α λλoPl ⊂≠
λ∧@∃∃(H$Hα""!~wtiHZ∀⊂ *@KDIZ$ λc:α1∩αIL TOKEN=")";
%%% $$1←MK_EXPR(S,SCALAR_VALUE, NIL_DIMENS);
%%% β
%%% ELSE α ERROR(160,"UNEXPECTED TOKEN FOUND IN MISC_RES :"&TOKEN);
%%% $$1←MK_EXPR(NULL,0,NULL_RECORD);
%%% β;
%%% ELSE α ERROR(170,"UNEXPECTED TOKEN FOUND ⊂"&TOKEN&"⊃, continue will return null expression");
%%% $$1←MK_EXPR(NULL,0,NULL_RECORD);
%%% β
%%% β;
%%% ELSE α ERROR(180,"UNEXPECTED TOKEN FOUND ⊂"&TOKEN&"⊃, continue will give null expression");
%%% $$1←MK_EXPR(NULL,0,NULL_RECORD);
%%% β
%%% β;
%%% RETURN($$1);
%%% β;
ELSEC
! EXP E: BF { OR BF }
BFACT BF: BT { AND BT }
BTERM BT: AE | AE <REL> AE
AEXP AE: {+|-} T {+|- T }
TERM T: F {*|/ F}
FACTOR F: PF or PF↑PF
PFACTOR PF: ( E ) or | E | or func(E,E,E,..) or <constant> or <id> or ¬ PF;
DEFINE EXP="(XXXXX(0))";
DEFINE EXP_XX=0,BEFACT_XX=1,BFACT_XX=2,BTERM_XX=3,AEXP_XX=4,TERM_XX=5,FACTOR_XX=6,
PF_XX=7;
! FORWARD RECURSIVE RPTR(EXPR) PROCEDURE EXP XXXXX(EXP_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BEFACT XXXXX(BEFACT_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BFACT XXXXX(BFACT_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE BTERM XXXXX(BTERM_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE AEXP XXXXX(AEXP_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE TERM XXXXX(TERM_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE FACTOR XXXXX(FACTOR_XX)
FORWARD RECURSIVE RPTR(EXPR) PROCEDURE PF XXXXX(PF_XX);
RECURSIVE RPTR(EXPR) PROCEDURE XXXXX(INTEGER LEVEL);
α RPTR(EXPR)$$1,$$2,$$3; INTEGER I,I2;
CASE LEVEL OF
α
[BEFACT_XX] [BFACT_XX] [AEXP_XX] [TERM_XX]
α
IF LEVEL=AEXP_XX AND TYPE_OF_RES_WORD = ADD_RES THEN
α I←SPECIAL_INFO;
GET_TOKEN; $$1←XXXXX(LEVEL + 1);
$$1←OPCODE(I,1,$$1);
β
ELSE $$1←XXXXX(LEVEL+1);
WHILE TYPE_OF_RES_WORD=RESCL[LEVEL] DO
α I←SPECIAL_INFO;
GET_TOKEN; EXPR:NEXT[$$1] ← XXXXX(LEVEL + 1);
$$1←OPCODE(I,2,$$1);
β;
β;
[EXP_XX] [BTERM_XX]
α
$$1←XXXXX(LEVEL + 1);
IF TYPE_OF_RES_WORD = RESCL[LEVEL] THEN
α I←SPECIAL_INFO;
GET_TOKEN; EXPR:NEXT[$$1]←XXXXX(LEVEL + 1);
$$1←OPCODE(I,2,$$1);
β;
β;
[FACTOR_XX]
α
$$1←XXXXX(LEVEL + 1);
IF TYPE_OF_RES_WORD = WRT_RES THEN
α I←SPECIAL_INFO; GET_TOKEN;
! Following is a kludge because v WRT f goes to (RVMUL (ORIENT f) v);
IF I≠WRT_X THEN EXPR:NEXT[$$1]←XXXXX(LEVEL + 1)
ELSE α $$2←XXXXX(LEVEL + 1);
EXPR:NEXT[$$1]←OPCODE(ORIENT_X,1,$$2);
β;
$$1←OPCODE(I,2,$$1);
β;
β;
[PF_XX]
CASE TYPE_OF_TOKEN OF
α
[NUMERIC_TOKEN]
α
$$1←MK_EXPR(TOKEN,SCALAR_VALUE,NIL_DIMENS);
GET_TOKEN3
β;
[ID_TOKEN]
α
$$1←MK_EXPR(TOKEN,ID_TYPE,ID_LIST:DIMEN[TOKEN_PTR]);
GET_TOKEN;
β;
[ARRAY_TOKEN]
α RPTR(ARRAY_LIST) APTR; INTEGER NARCS,ARGS; STRING S;
APTR←TOKEN_PTR; S←"$ARAF "&TOKEN;
GET_TOKEN;
IF TOKEN≠"[" THEN ERROR_reject(51,"neEd a [ after array variable,continue will insert");
GET_TOKEN;
NARGS←arrAy_LIST:#DIMENS[APTR];
FOR ARGS←1 STEP 1 UNTIL NARGS DO
α
$$1←EXP;
CHECK_DAMENSAONS("field of array variable, which should be dimensionless",
nil_dimens, expr:dimen[$$1]);
if expr:Type[$$1]≠scalar_value then
error(51,"field of array variable should be a scalar expression");
if args≠nargs and token≠"," then~∀$∩∩∩∪∃ee←daeKUK
hPjd0E]KK⊂@XAE∃ioKK8ACeOU[K]iLA←LA∧ACee¬rAmCISCEY∀DR~∀$∩∩∩∪∃YgJA%LACe≥f{]CIOfAC9HAi←-K\6EtDAiQ∃\~∀∩$∩∩∪KIe←d1IKUKGPPjdX ]KKH↓:ACMQKdAY¬ghACIOk[K9hA←L↓BACeICrAm¬eSCE1JDRv4∀∩∩∩%g?fLλ@DMKaaduE=Is6H⊂c:f~(∩∩∩∪≥Kh1i=WK\v4∀∩∩∩$εv~∀$∩∩∩H⊂c?[VaKqad DPDMLLDRD1CeeCd1YSgPuisa∃7CaiI:YCeICr1Y%ghuI%[K]7¬aie:$v~∀~(∩∩∩εl~∀~∀$∪7!%=π +I
1)∨- ≥ 4hP$$$∩βOSKNs∃βMXβ';S.;↔Iβ'#gC∃Xh($$O∪CSIGβK?∂.#WK∀Fc'OQOβCSIZβ';S.;↔Iβv K∨Mf K∨MXh($$OβCSJ␈#?/↔qCCSIZβN⎇ $~ε2⊃α⊃~R>\*9l4PH$'∨/ cS?↑+9l4PH$&&2↓#;π⊗;N⎇βπ∪?∂↔'+K∀cfKOQi≡ K∨N←βCSJjHm@4PH$'SF+84(HH%↓↓αλ4(HH%↓↓αβ'→β&{/↔8Z⊃! β&C↔9β/∪K?HG∪↔+↔∨!!UQb∪;↔↔"↓!β#/∪∃β≠␈⊃βCK}≠↔∪W⊗) %lhP$$%α↓↓β∨/ cS?↑+9l4PH$%↓α↓β≠?∩βπK∨≥yEβO&+A↓Eπ+;S'bβ;πK?→β∪<hP$$$H⊂4($HH''→πβK?∂.#WK∀Fc'OQVKO'∩←βCSJm[πK∨≥h4($HH$'SF+9λhP$$$HH'SSOβ⊗␈'!C3'O#SSgC-[CK?≡+∪WK)C3'O#SπK∨≥[CCS∃joπK?~vulhP$$$HH%⊃⊃
{↔cAXh($$HH$$ hP$$$HK↔3O*λ4(HH$$$M#SgC-{πKK∂Hc3'∨!kSgε*gCK}≠↔∪W⊗(c3'∨!kπK?~gCC'∩voπ⊗;NvuXh($$HH$''2βSgC)C?_c&{/↔8↑ KKπICS?/.p4($HH$$$O##↔9ε+KK?∩AUM1⊗s↔↔⊃ε KKπJβ;π7*β#↔K*⊃%l4PH$$$HI⊃⊃F|j,b⊗EαI"R|Z⊗93∂∪KπdFc'OQU#gC⊗←#?/↔qCCSJj`4($HH$$%αβπKK∂Hc3'∨!k∪'n+:oS}[↔8c¬#Ju%Xh($$HH$'∨/ cS?↑+9l4PH$$$HH
l4PH$$'N1βSSOβ∀o↔GβIkSMβ⊗m⊃#
t4(HH$$'&C↔9β-∪K?IC)M1 ∂∪∨W7.sQ↓ 6≠[Mβ∂∪∨M%2⊃β/→πβK/∂.#WK∃ε#?πMεs?QβF [∃β≡ 7∃β'KC∃β∂→β∪↔≤¬F∂⊗\D"KXQ!⊂HH≤=ε.≡3 FNn]n6N}n5α⊗∂,}Vn.n@α∩⊗>j2F∂,}2Jαd λ
|β⊂8 2ocedure",
(if prkce@⊃keJ11SghuαK@≡NK>ππ'+[6∂⊗};Rπ& ]`hPα""!≥9ε≠
≡⎇∞Q
≥9;Vn∞[xp∩Y8¬re_listiCeOgmaai@∃joπK?~vuβ,¬G∞(β"B!⊃"8<N,>&≠
≡⎇∞Q
≥9;Vn∞[xp∩Y8¬re_list~argc[pptb]Yargs]]),
expr~di`≠K96HHctRv~∀$∩∩∪Sα1βπK?_o+π⊗;Eβπv!βS?↑+8m b⊂4(⊃⊃⊂Jα∧∧π&F]`λ ↑\[p→ε92u %ct 54,"`≥Kα+⊃↓Dλ
t≤y4 ≡X=→$ <Y⎇-\8π:9H4πf @∧Aae←α≠↔βW⊗)↓$Q!⊂HH∀∧ααε]H lT~9H ≡Y|o-l<Y|d 9Y⊂≥7urwεQ∀QεB∧@DDH⊂⊂⊂4he`≤A∃ae←DaeKUKα≠Q!U⊂¬B⊗@Y91∧¬(_9NL<H⊂⊗_yz⊂ \3zvr[8⊂7`& pro@
KAke∀AGCYαa∩Kαc"A⊃""9l↑∧≥≠m<αw∃FB∧DDD\myS⊃λ⊃∪2@8pr:body[$∧1]0⊗~(∩∩α∩ r~∧∩$∩@@@εv~∀$∩∩HHβ
␈7,F+cCIB⊃! ≠~1∩J%H ∞-βqr`$ure_list:@QsaK7Aaie:α`4(⊃⊃⊂Oπ-xλl\≥<Y#
~<p~∞24vr[-x8 4p¬2Rv4⊂∩α∩ r~∀~(∩∪7∀*N⊗J4*⊂bR|Z⊗:@QQ HHα0p*8(⊂
,T"L'cε)"`∪_WH∂%λ↓≠ 4PH$$λhP$$&↑ Lc⊗+NtQ!⊂HH⊂ λλx5 *∪βKENl@@Hc⎇ 1 W%?'!
∪β_DJ2
=Xh($$HJ&→ααIt\,c0'b⊂β"B!⊃"5∩λYβ⊂"i∀'i_REJECT(150,"MISMAP π⊃∃λA- I(A¬βHXA/∪1_A&u~⊗JQ⊂¬⊂hPα""!_3∀q$λq0
∃'` EN;
$$E?⊂≡B≤z∩∃"JaE "D@ %↔c"B!⊃ naQ@εE∧BDh f@U]F1e∃g:4PH$$$⊂∧∧Mzλ∧tλXp∧`fε$g#'NFA∧DBDcbjε* ∂KEL∧v
∀$∩∩&L1αRy8T`#hJ⊃βE P@⊃ 8A⊗J∀zHbJ,R⊗∞Q@ε∪ &λε⊃ ⊃hjdi⊃P EFT PAREN _A]∪⊂∩D ∀`*q0 *λα)~∀$∩∩&,bN∃α<*PbR|Z⊗9@1Q HHα")∧FTπR$1[E@1@p
α¬∃yEl4PH$$&<B& $T
Dl\Y`∂$⊗⊃⊂"∪FA∧DBD@ α↓∂β(E"0≤\Y`∞d∧ wh[∀λ
DRY(∂I∩ + !l~∀$HH$%⊂ ε%`5⊃0 (∀≥ ∞EXT[$$I;0≥⊃ ε2KXQ!⊂HHα" gF@
IF TO@↔ 86DRD4⊂λ$⊃⊃∩αα∧
DD3H⊃**StF
(2Q0jE -L¬DPεdiS`j!d⊃b⊂ ⊂AR@ ≤X↓(∞&2bα& 58Z%"∩⊃Q HHα"(∧∧λ⊃3
_αP#bU *'eQdε 6~(∩α$H!↓F↓yz∧9βb"T∩T∧@∩dαa↓#∃⊂∞aP¬ β;
∀$HJ`≡→8`⊗_y2L 2esU
∩∩λA∪ =¬~B,9_∀aDα3QI@P⊂ @=`1G←β+;AlhP$$⊃⊃∀<
@ε∃ @ebg;
∩∩$∪∪ AQ_∞.⊗qY∩B!Q HHα"5 λαg⊂"T) ∂B_R@ ∃
(@!E3↓1
J-
V&J*α2,h¬~λ4Q3ED⊃r3 D⊂∧g)Qi*↓)
∀$HH&⊗2≤!α<X¬ε
Ip¬bg∞β
∀∩$∩αH↓ ε%zαD≠t-E∞`→⊗TπX@; α∩∩$∪ ≡ →D*∧¬∪rhYβ_
"0@ α∩xh ⊂Hα""!⊂H⊃q*C∃∪rhYβ_ $$3P∨ a v∪∩β∩p≤K$¬2β αc"A⊂ ∧DDH∧ λe>αB⊗b↓λ∧@∃∩α@ 1%Y" S7dDα→T@;;
IF TOKEN≠")"
THEN ERROR_REJECT(160,"MISMATCHED PAREN, WILL INSERT")
ELSE GET_TOKEN;
β;
[NOT_RES]
α I←SPECIAL_INFO; GET_TOKEN;
$$1←EXP;
$$1←OPCODE(I,1,$$1);
β;
[OR_res]
α
$$1←MK_EXPR(CURRENT_FRAME,
FRAME_VALUE,DISTANCE_DIMENS);
GET_TOKEN;
β;
[MISC_RES]
IF EQU(TOKEN,"INSCALAR")
THEN α
$$1←MK_EXPR("($SCALRD)",SCALAR_VALUE, NIL_DIMENS);
GET_TOKEN;
β
ELSE IF EQU(TOKEN,"QUERY")
THEN α
STRING S;
S←"($QUERY ";
GET_TOKEN;
IF TOKEN≠"(" THEN ERROR_REJECT(161,"need ( after QUERY");
DO α
GET_TOKEN;
IF TYPE_OF_TOKEN=STRING_TOKEN THEN
α S←S&dquote&TOKEN&dquote&" "; GET_TOKEN; β
ELSE α $$1←EXP;
S←S&EXPR:BODY[$$1]&" ";
β;
IF TOKEN≠"," AND TOKEN ≠")" THEN
ERROR(162,"need , between arguments of QUERY");
β UNTIL TOKEN=")";
S←S&")";
$$1←MK_EXPR(S,SCALAR_VALUE, NIL_DIMENS);
GET_TOKEN;
β
ELSE α ERROR(160,"UNEXPECTED TOKEN FOUND IN MISC_RES :"&TOKEN);
$$1←MK_EXPR(NULL,0,NULL_RECORD);
β;
ELSE α ERROR(170,"UNEXPECTED TOKEN FOUND ⊂"&TOKEN&"⊃, continue will return null expression");
$$1←MK_EXPR(NULL,0,NULL_RECORD);
β
β;
ELSE α ERROR(180,"UNEXPECTED TOKEN FOUND ⊂"&TOKEN&"⊃, continue will give null expression");
$$1←MK_EXPR(NULL,0,NULL_RECORD);
β
β
β;
RETURN($$1);
β;
ENDC
! exp2 starts here, p_exp_basic;
GET_TOKEN;
OUTEXPR←EXPR:BODY[$$1←EXP];
REJECT←TRUE;EXP_TYPE←EXPR:TYPE[$$1];
EXP_DIMENS←EXPR:DIMEN[$$1];
RETURN(TRUE);
DONEP:RETURN(FALSE);
β;
BOOLEAN PROCEDURE P_EXP_BASIC;
α
BOOLEAN B1;
IF (B1←P_EXP2_BASIC)=TRUE THEN PRINT(OUTEXPR);
RETURN(B1);
β;
! P_condition;
BOOLEAN PROCEDURE P_CONDITION_BASIC(INTEGER PP;STRING PRELUDE);
! returns true if successful, false otherwise;
α STRING COND,OP; LABEL FLUSH; RPTR(DIMENS_EXPONENT)PTR;
LABEL DONEP;
PROCEDURE F_STATE(VALUE INTEGER IP; VALUE STRING SP);
α STRING CLOSE; INTEGER I;
ERROR(IP,SP&crlf&"Continue will flush statement.");
WHILE ¬EQU(TOKEN,";") DO GET_TOKEN;
REJECT←TRUE;
NUM_OF_ERRORS_FLUSHED←NUM_OF_ERRORS_FLUSHED+1;
GO TO FLUSH;
β;
PROCEDURE P_EXP2; IF P_EXP2_BASIC=FALSE THEN GOTO DONEP;
PROCEDURE P_EXP; IF P_EXP_BASIC=FALSE THEN GOTO DONEP;
RPTR(DIMENS_EXPONENT)
procedure CHECK_DIMENSIONS(STRING S; RPTR(DIMENS_EXPONENT) D1,D2);
α RPTR (DIMENS_EXPONENT) R1;
R1←CHECK_DIMENSIONS_PROG(S, D1,D2);
IF GLOBAL_MODIFIED=TRUE THEN α GLOBAL_MODIFIED←FALSE; GOTO DONEP;β;
RETURN(R1);
β;
BOOLEAN PROCEDURE CHECK_EXP_TYPE_DIMENS(INTEGER DESIRED_EXP_TYPE;
RPTR(DIMENS_EXPONENT) PTR;
STRING ERROR_MESS);
α BOOLEAN B1; B1←CHECK_EXP_TYPE_DIMENS_PROG(DESIRED_EXP_TYPE, PTR, ERROR_MESS);
IF GLOBAL_MODIFIED =TRUE THEN α GLOBAL_MODIFIED←FALSE; GOTO DONEP; β;
RETURN(B1);
β;
rptr(any_class) PROCEDURE ERROR(INTEGER I; STRING S);
α rptr(any_class) r1;
GLOBAL_BACKUP←TRUE; r1←ERROR_BASIC(I,S);
IF GLOBAL_MODIFIED = TRUE THEN α GET_TOKEN; GLOBAL_MODIFIED←FALSE;
GOTO DONEP; β;
return(r1);
β;
GET_TOKEN;
IF ID_TYPE=event_Value THEN
α PRINT(PRELUDE& " " & TOKEN);
RETURN(TRUE);
β;
IF TYPE_OF_RES_WORD=cm_RES or equ(token,"FORCE") OR EQU(TOKEN,"TORQUE") THEN
α "CM_RES"
INTEGER FORCE_TYPE;
IF SPECIAL_INFO=nil_CM
THEN COND←TOKEN
ELSE
α ! YOU MIGHT WANT TO INCORPORATE ALL OF THIS INTO P_EXP2;
FORCE_TYPE←SPECIAL_INFO;
if force_type=torque_CM or force_type=force_cm
then
α COND←"FORCE "; GET_TOKEN;
IF FORCE_TYPE=TORQUE_CM THEN PTR←TORQUE_DIMENS ELSE PTR←FORCE_DIMENS;
IF EQU(TOKEN,"(")
THEN
α "("
P_EXP2;
IF EXP_TYPE≠vector_VALUE THEN F_STATE(1202,"Need vector here.");
COND←COND&" "&OUTEXPR; GET_TOKEN;
IF ¬EQU(TOKEN,")")
THEN ERROR(1201,"Need right paren here. Continue will insert it.");
GET_TOKEN;
IF TYPE_OF_RES_WORD≠ORDER_RES
THEN ERROR(1202,"Need relational operator here");
IF TOKEN_EQU("≤")
THEN α
ERROR(1202,"Need < here instead of ≤, continue will assume < ");
token←"<";
β
ELSE IF TOKEN_EQU(">")
THEN α
ERROR(1203,"Need ≥ here instead of >, continue will assume ≥ ");
TOKEN←"≥";
β;
PRINT(PRELUDE&" ($"&COND& " "&token); SPACING←SPACING+1; P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,PTR,"Force or Torque condition monitor")
THEN ERROR(49,"Need scalar quantity here.");
if force_type=force_cm
then PRINT(" + )")
else if force_type=torque_cm then print(" - )") ELSE PRINT (" )");
SPACING←SPACING-1; RETURN(TRUE);
β "("
ELSE
IF TYPE_OF_RES_WORD=ORDER_RES
THEN
α "="
STRING REL_OP, SCAL_EXP,VECT_EXP,FFBF,PLUS_MIN;
REL_OP←TOKEN;
IF TOKEN_EQU("≤")
THEN α
ERROR(1202,"Need < here instead of ≤, continue will assume < ");
rel_op←"<";
β
ELSE IF TOKEN_EQU(">")
THEN α
ERROR(1203,"Need ≥ here instead of >, continue will assume ≥ ");
REL_OP←"≥";
β;
IF FORCE_TYPE=FORCE_CM THEN PLUS_MIN ← " + " ELSE PLUS_MIN←" - ";
P_EXP2; FFFF←null;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,PTR,"Force or Torque condition monitor")
THEN ERROR(49,"Need scalar quantity here.");
SCAL_EXP←OUTEXPR≠ GET_TOKEN;
IF ¬TOKEN_EQU("ALONG","ABOUT")
THEN
α if ¬token_equ("WITH","ON",";")
THEN ERROR(1205,"Need ALONG or ABOUT here, continue will insertit.");
REJECT←TRUE;
β
ELSE
α P_EXP2;
IF ¬CHECK_EXP_@)e!
1 %≠ ≥&!-KGi=d1mC1kJXA9SX!I%[K]f0EISe∃GiS←8AmKGQ←dDR4∀∩∩∩@@Ai!K\AKIe←dPPpX@E9KKHAYKGi←HAKqaIKggS=\AQKIJDRv4∀∩∩∪YKGh1∃qa?←UiKqaHvA∂ P1)∨↔∃≤v~∀$∩∪∪ )∨↔∃≤1 #TPE∨ λRA)⊃∃≤A% ) π)?Q%+
~(∩∩∩@@A →M
~∀∩$∩@@@∧A 1∃1 dv4∀∩∩∩@@A∪_A 1 a)3!
m)%β≥L1-β→U
Aβ≥⊂A 1a)3!
m%∨(1Yβ⊃+
~∀∩∩$∪)⊃ 8A %%=$Pbd@lX@E9KKHA→eC[J↓←dAe=hAmC1kJAQ∃eJDRl~∀∩∩$@@@A→
>λPI
∨Iπ
1
Iβ≠
@λM←ki∃qadvαα≡⊗PE">.⊗sX4($HI↓↓↓∧J→⊗$z.⊗8D*FU!N")
THEN α REJECT←TRUE; FFFF←FFFF& " # )"; β
ELSE
α GET_TOKEN;
IF TOKEN_EQU("WORLD","STATION","FIXED")
THEN FFFF←FFFF & " # )"
ELSE
IF TOKEN_EQU("HAND","BHAND","YHAND","MOVING")
THEN FFFF←FFFF& " ⊗ )"
ELSE
α ERROR(1209, "Need FIXED or MOVING here, Continue will treat as station");
FFFF←FFFF&" # )";
β;
GET_TOKEN;
if ¬token_equ("COORD","COORDS","COORDINATES")
THEN REJECT←TRUE;
β;
β;
β;
print(PRELUDE);
PRINT("($"&COND& " "&VECT_EXP&" "
& REL_OP & " " & SCAL_EXP& " "&
PLUS_MIN & FFFF& " )");
β "="
ELSE ERROR(1204, "Need relational operator here");
β
ELSE
IF FORCE_TYPE=duration_CM
THEN
α PTR←TIME_DIMENS; cond← "DURATION "; GET_TOKEN;
PRINT(PRELUDE&" ($"&COND& " "&token);
SPACING←SPACING+1; P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,PTR,"Duration condition monitor")
THEN ERROR(49,"Need scalar quantity here.");
PRINT (" )"); SPACING←SPACING-1; RETURN(TRUE);
β
ELSE
α ERROR(1203, "Only force or torque condition monitor allowed");
print(" )");
β;
β;
β "CM_RES"
ELSE
α REJECT←TRUE; P_EXP2;
IF EXP_TYPE≠boole_Value and EXP_TYPE≠scalar_VALUE
THEN F_STATE(44, "Need boolean expression or force_type predicate in condition monitor");
PRINT(PRELUDE); print(outexpr); return(TRUE);
β;
FLUSH: RETURN(TRUE);
DONEP: RETURN(FALSE);
β;
! P_clauses, T_gen;
BOOLEAN PROCEDURE P_CLAUSES_BASIC;
α "P_CLAUSES"
BOOLEAN T; LABEL FLUSH; BOOLEAN ICMT;STRING LABL; INTEGER LAB_TYPE;
LABEL DONEP;
PROCEDURE P_EXP; IF P_EXP_BASIC=FALSE THEN GOTO DONEP;
PROCEDURE P_EXP2; IF P_EXP2_BASIC=FALSE THEN GOTO DONEP;
PROCEDURE P_CONDITION(INTEGER II; STRING SS); IF P_CONDITION_BASIC(II,SS)=FALSE THEN GOTO DONEP;
RPTR(DIMENS_EXPONENT)
procedure CHECK_DIMENSIONS(STRING S; RPTR(DIMENS_EXPONENT) D1,D2);
α RPTR (DIMENS_EXPONENT) R1;
R1←CHECK_DIMENSIONS_PROG(S, D1,D2);
IF GLOBAL_MODIFIED=TRUE THEN α GLOBAL_MODIFIED←FALSE; GOTO DONEP;β;
RETURN(R1);
β;
rptr(any_class) PROCEDURE ERROR(INTEGER I; STRING S);
α rptr(any_class) r1;
GLOBAL_BACKUP←TRUE; r1←ERROR_BASIC(I,S);
IF GLOBAL_MODIFIED = TRUE THEN α GET_TOKEN; GLOBAL_MODIFIED←FALSE;
GOTO DONEP; β;
return(r1);
β;
BOOLEAN PROCEDURE CHECK_EXP_TYPE_DIMENS(INTEGER DESIRED_EXP_TYPE;
RPTR(DIMENS_EXPONENT) PTR;
STRING ERROR_MESS);
α BOOLEAN B1; B1←CHECK_EXP_TYPE_DIMENS_PROG(DESIRED_EXP_TYPE, PTR, ERROR_MESS);
IF GLOBAL_MODIFIED =TRUE THEN α GLOBAL_MODIFIED←FALSE; GOTO DONEP; β;
RETURN(B1);
β;
PROCEDURE F_STATE(VALUE INTEGER IP; VALUE STRING SP);
α STRING CLOSE; INTEGER I;
ERROR(IP,SP&crlf&"Continue will flush statement.");
WHILE ¬EQU(TOKEN,";") DO GET_TOKEN;
REJECT←TRUE;
NUM_OF_ERRORS_FLUSHED←NUM_OF_ERRORS_FLUSHED +1;
GO TO FLUSH;
β;
ICMT←INSIDE_CONDITION_MONITOR;
T←TRUE; GET_TOKEN;
WHILE T DO
α
LABL←NULL;
IF (LAB_TYPE←ID_TYPE)=LABEL_VALUE
THEN IF DEFINED(TOKEN_PTR)
THEN ERROR(123,TOKEN& " already used.")
ELSE
α DEFIN(TOKEN_PTR); LABL←TOKEN;
INSIDE_CONDITION_MONITOR←TRUE;
GET_TOKEN;
IF ¬EQU(TOKEN,":") THEN ERROR(23,"Need colon after label " & LABL & " .") ELSE GET_TOKEN;
β;
IF (TYPE_OF_RES_WORD=on_RES)
THEN
α
INSIDE_CONDITION_MONITOR←TRUE;
IF EQU(TOKEN,"ON") THEN P_CONDITION(2,"( "&LABL& "$ON +")
ELSE α CHECK_NEXT_TOKEN(37, NULL,"ON"); P_CONDITION(2,"( " & LABL& "$ON -"); β;
SPACING←SPACING+1;GET_TOKEN;
IF ¬EQU(TOKEN,"DO") THEN ERROR_REJECT(45,"Need DO here. Continue will insert it.");
P_STATEMENT;SPACING←SPACING-1; PRINT(")"); GET_TOKEN3
β
ELSE IF EQU(TOKEN,"(") THEN
α INTEGER C; STRING TEMP;
! LEFT PAREN FOUND - STAIGHT TRANSFER;
C←1; TEMP←"(";
WHILE C>0 DO
α
TEMP←TEMP&READ(paren_cr_break);
IF BRCHAR="("
THEN C←C+1
ELSE IF BRCHAR=")"
THEN C←C-1
EHSE α PRINT(TEMP); TEMP←NULL; β;
β;
PRINT(TEMP); GET_TGKEN;
β
EHSE IF ¬(move_beg ≤ TYPE_OF_RES_WORD ≤ move_end) THEN
α
! EJD OF MOVE STATEMENT FOUND;
REJECT←TRUE;T←FALSE;
β
ELSE CASE TYPE_OF_RES_GORD - move_beg OF
α
[via_X] α ! VIA CLAUSE FOUND;
PRINT("($TIA "); SPACING←SPACIJG+1; P_EXP;
IF EXP_TYPE≠frame_exp_VALUE THEN ERROR(1202, "Need trans value expression here")3
GET_T@∨↔∃≤v~∀$∪∪ A∃#*Q)=↔ ≤XλXDRAQ⊃ ≤~(∩∩∩∧α↓αNB ~&:≡⎇~Bε∞Lr≥%EX∧¬¬∀→jBB∩∀%∪Xh!∀HMy ∀d
λZ∃*EIy4,rβλK∧¬(⊃∪aQ@(α!⊃ C"A⊃""4
)3U
∧¬ ∃R(∀λJ.d
t⊂0i→Qwtjλ0r3Hul.`
β⊃6∀π1"B"!⊃21Hλ[∀ε∃ ~⊃&yN,;9& ←≤ε∃H→∃1(
I⊃3HλZTStEε,L EDλSY,\λ≥≤L≥\h≥L≥≥9( ←≤≤Y.>z;{D
→<Y$%,c"A⊃""4jλ0r3H{tt⊂(93Qk&↔h∀∀I→U
λE∀J.`λx5α∃ yq3FaQ@(α!⊃ nc!!"" aQB"1)Jq" DλSssλX3H∃CλSu3HE⊃α⊃Iz3Qβλ9sQ∩)Gh⊂sij∩3WjJU1.aQB"")_H⊃4*U∃∪rhYIλUiλ4Q(E∀∃∩⊃)a"B"!⊃5r∩)H(↓*
C⊃Su)hλ↓λλC⊃Su)h
(↓∧λqsU →H⊃∪aQ@""!⊂A"B!⊃ 1q*C∃∪rhYL¬FEαDDDdQ⊂+ #∪jg" ∧ E@#TQ)>\*91
4*2>∞M"e %¬""⊗8hP$$$HJ_bNαH∃$*ε6β
D)W.gM≡εf*
hTd|9~EJπ>λ ,=9Z0⊃Xz4wwλ33z`.d inTπ∪)⊂↓GYCkβ≠∃ 2%⊃PPH⊃⊃∀,@∀q( _H⊃4*U∃∪rhYKλUHY⊂πadU,Q∀P∃$"gεB∧DDDBA⊂()∩dεT("( - 1≠π∪)d@DRvαα≡⊗Pβ
D|\Yg0hPα""!⊃21HX45*
Irq3EDO(@∀H*$"gλ"i)'T )"e⊃aj∀→L_Z⊗⊃∪2rr⊂∂P42i→W⊃∀]CE∧DDBDih Pdg#oTh adS!UX@; P_EXP;
↓ SPACING[SPACING-1; PRIJT(")");
IF ¬AHECK_EPP_TYPE_DIMENS(vector1Yβ⊃+
1- →∨
∪)2⊃⊃∪≠ ≥LX~∀∩$∩∩∩∩ -KY←
SibAα+cCK/≠O'?r⊃%αRD*8$(HH$$$H⊂4($HH$$&≥αε∞&t:}NB ~&*≥k mαB∀J:Q!∩I↓%LhP$$$HH&_b≥"εR∃C→AEIb∩;↔↔"β¬β[,≠S?Iε+cCK/≠O'?pβ#↔K*q %@1Q HH⊃⊃⊂H≠1Q HH⊃⊃∃ #⊃Su)h↔u∀JX,h⊃hZ∧∃∪i83Nc!!"""!→1H↓(Z5*∃ @ebg⊗λ⊗⊃∀P∃$"g⊂⊂gg"$S-c f∀b]FEαDDDD@FE∧DBDbf)QP c⊂⊃ #'jS"⊂α⊂⊃hjT*∪βKEN,"@U@%¬)∪∨≤λRA)⊃∃≤∩∀∩$∩∩∪ a')β)∀Pf`bβ→1
7.cS'Cd)ααVα(∃$Ly`π∂ε\=⊗ -8x=
≥{H⊂∪≠zw2 in WITH clause. )~∀$∩∩∪ 1'
A∪_A #*!)∨↔ 8XE +Iβ)&|q %ααI∧,pβ"B!⊃QU(TOKEN,"=") ∨ EQU(TOKEN,"<") ∨ EQU(TOKEN,">")) THEN
ERROR_REJECT(3014,"Need =,<, or > here.");
PRINT("($DURATION " & TOKEN & " ");
SPACING←SPACING+1;P_EXP;SPACING←SPACING-1;
PRINT(")");
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE, TIME_DIMENS,
"DUARATION clause")THEN
α SPACING←SPACING-1; PRINT(")");
F_STATE(3012,"Need a scalar expression here.");
β;
D_FOUND←TRUE; GET_TOKEN;
IF ¬EQU(TOKEN,",") THEN CONTIN←FALSE;
β
ELSE CONTIN←FALSE;
β;
IF EQU(TOKEN,"THEN") THEN
α PRINT("($THEN"); SPACING←SPACING+1; P_STATEMENT; SPACING←SPACING-1;
PRINT(")");GET_TOKEN;
β;
SPACING←SPACING-1; PRINT(")");
β;
β;
[directly_X] α
PRINT ("($ARRIVAL NILDEPROACH)");
PRINT ("($DEPARTURE NILDEPROACH)");get_token;
β;
[with_X] α;
GET_TOKEN;
IF TYPE_OF_RES_WORD=approach_RES THEN
α "APPROACH_RES"
if equ(token,"ARRIVAL")
then ERROR(-1,"Use APPROACH instead of ARRIVAL")
else if equ(token,"APPROACH") then token←"ARRIVAL";
PRINT("($" & TOKEN); SPACING←SPACING+1; GET_TOKEN;
IF ¬EQU(TOKEN,"=") THEN ERROR_REJECT(3022,"Need = here.");
GET_TOKEN;
IF EQU(TOKEN,"NILDEPROACH") THEN PRINT("NILDEPROACH")
ELSE IF EQU(TOKEN,"DEPROACH") THEN
α
PRINT("($DEPR"); SPACING←SPACING+1; GET_TOKEN;
IF ¬EQU(TOKEN,"(") THEN ERROR_REJECT(3019,"Need left paren here.");
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(frame_exp_VALUE,DISTANCE_DIMENS,
"FRAME expression")
THEN F_STATE(3020,"Need frame exp here.");
GET_TOKEN;
IF ¬EQU(TOKEN,")") THEN ERROR_REJECT(3021,"Need right paren here.");
SPACING←SPACING-1; PRINT(")");
β
ELSE α
REJECT←TRUE;P_EXP;
IF EXP_TYPE≠scalar_VALUE ∧ EXP_TYPE≠vector_VALUE ∧ EXP_TYPE≠trans_VALUE THEN
ERROR(3018,"Type mismatch for DEPROACH.");
β;
SPACING←SPACING-1; PRINT(")");
β "APPROACH_RES"
ELSE IF EQU(TOKEN,"WOBBLE") THEN
α "WOBBLE"
GET_TOKEN;
IF ¬EQU(TOKEN,"=") THEN ERROR_REJECT(3022, "Need = here.");
PRINT("($WOBBLE "); SPACING←SPACING+1; P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE, ANGLE_DIMENS,
"WOBBLE Clause")
THEN F_STATE(3012,"Need a scalar expression here.");
SPACING←SPACING - 1;PRINT(")");
β "WOBBLE"
ELSE IF EQU(TOKEN,"FORCE") OR EQU(TOKEN, "TORQUE")
THEN α REJECT←TRUE; P_CONDITION(2,NULL); β
ELSE IF EQU(TOKEN,"DURATION") THEN
α;
GET_TOKEN;
IF ¬(EQU(TOKEN,"=") ∨ EQU(TOKEN,"<") ∨ EQU(TOKEN,">")) THEN
ERROR_REJECT(3014,"Need =,<, or > here.");
PRINT("($DURATION " & TOKEN & " ");
SPACING←SPACING+1; P_EXP; SPACING←SPACING-1; PRINT(")");
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,TIME_DIMENS,
"DURATION clause")
THEN F_STATE(3012,"Need a scalar expression here.");
β
ELSE IF EQU(TOKEN,"SPEED_FACTOR") THEN
α
GET_TOKEN;
IF ¬EQU(TOKEN,"=") THEN
ERROR_REJECT(3014,"Need = here.");
P_EXP2;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,NIL_DIMENS,
"DURATION clause")
THEN F_STATE(3012,"Need a scalar expression here.");
PRINT("($SPEED_FACTOR "& OUTEXPR & " )");
β
ELSE IF EQU(TOKEN,"NO_NULLING") THEN PRINT("($NNULL +)")
ELSE IF EQU(TOKEN,"NULLING") THEN PRINT("($NNULL -)")
ELSE IF EQU(TOKEN,"FORCE_FRAME") THEN
α
STRING FFFF;
GET_TOKEN;
IF ¬EQU(TOKEN,"=") THEN
ERROR_REJECT(3014,"Need = here.");
P_EXP2;
IF EXP_TYPE≠trans_VALUE and EXP_TYPE≠rot_VALUE THEN
ERROR(3012,"Need a trans or rot expression here.");
GET_TOKEN;
IF ¬EQU(TOKEN,"IN") THEN error_REJECT(46,"Need IN here, will insert it");
GET_TOKEN;
IF TOKEN_EQU("STATION","TABLE","WORLD","FIXED") THEN
FFFF←" #"
ELSE IF TOKEN_EQU("HAND","BHAND","YHAND","MOVING")
THEN FFFF←" ⊗" ELSE FFFF←NULL;
PRINT("($FORCE_FRAME " & OUTEXPR & FFFF & " )");
get_token;
IF ¬TOKEN_EQU("COORD","COORDS","COORDINATED") THEN REJECT←TRUE;
β
ELSE F_STATE(3016,"Illegal WITH clause.");
GET_TOKEN;
β
β;
β;
FLUSH: INSIDE_CONDITION_MONITOR←ICMT; RETURN(TRUE);
DONEP: RETURN(FALSE);
β "P_CLAUSES";
STRING PROCEDURE T_GEN;
α
T_COUNT←T_COUNT+1;
RETURN("_T"&CVS(T_COUNT));
β;
! P_statement, F_state, modify_continue, modify_flush;
RECURSIVE PROCEDURE P_STATEMENT;
α "P_STATEMENT"
LABEL GLOBAL_RE_TRY;
LABEL FLUSH,TRY_AGAIN; STRING LABL; INTEGER LABEL_TYPE;
RPTR(DIMENS_EXPONENT) DIM_PTR;
rptr(any_class) PROCEDURE ERROR(INTEGER I; STRING S);
α rptr(any_class) r1;
GLOBAL_BACKUP←TRUE; r⊃←ERROR_BASIC(I,S);
IF GLOBAL_MODIFIED = TRUE THEN α GET_TOKEN3 GLOBAL_MODIFIED←FALSE;
GOTO GLOBAL_RE_TRY; β;
return(r1);
β;
RPTR(DAMENS_EXPONENT)
procedqre CHECK_D@∪≠∃≥'&|rM"N%∩&:≥¬→mαJ¬"I"∩Lj⊗:LD*bB>t*:Q¬∧!E2⊃∩Il4(∩αJBR⊂∧αD$α31)jd⊃6
sQ3JE(∀@_NFE∧i oad"PeL"$Sbg)dSg)L(∀'cT)K⊂"_@,D2);
IF GLOBAL_MODIFIED=TRUE THEN α GLMBAL_MODIFIED←FAHSE; GOTO G@→∨ β_1%∀1)%2l@εv~)% )+I≤Q$b$v~∀εl~∀~∃ ∨∨ ¬≤A!%=π +I
Aπ⊃∃π⊗1 a 1)3A
1 ∪5 ≥&Q%≥) ∂∃$A M∪% λa 1 1Q3!
v4∀∩∪%A)$Q %≠ ≥&a 1!∨9 ≥(R↓!)$v4∀∩∪'Q%∪≥∞↓ %%∨H1≠ 'LRv~∀λA¬∨∨1 β≤AλbvA∧E?π⊃
⊗1 1@1)3!∀1 β≠∃≥&1↓I∨∞Q ∃'∪% ⊂1 1 a)3!
0A!)$αaα⊗J∀zHb6-~M%@1Q$L2λyDl∀→C∧l|I_dL,DπU%∃XT¬$DYd∩∧yIt∀ A T|$_i∀,%xh∀e≤W0λλyβj'P⊃f#a S )"L∃),]P]FE)⊃j*a'
!_T]CE↓]FBεE()∪abb*T P ⊃l(≥FB$c⊂(ε"l( ⊂ idaOc f)QP*$"S⊂#gj∪β GLOBALλRE_TRY;
PROCEDURE P_EHP2;
IF P_EXP21 β'∪εu
β→'∀A)⊃ 8A∂∨)<A∂2|∩ε0b∀(bRJKX4(∀UαJ>∞,"VJ∃¬b∞≡t"&R→ybDLh¬⊃(x4H∀
πtu∀I→β#P(∀"f*b⊃TYFEαdc⊂(ε!gg"∩j ON_BASIC(PP,PRELUDE)=FAHSE THENGKTO GLOBAL_RE_TRY;
PROCEDURA @_CHAUSES;
IF P_CLAUSES_BASIC=FALSE THEN GOTO GDOBAL_RE_TRY;
¬
PROCEDURE F_STATE(VALUE INTEGER PP,IP(-10000); VALUE STRING SP(NELL));
α STRING CLOSE; INTEGER I; CLOSE←NULL;
FOR I←1 STEP 1 UNTIL PP DO CLOSE←CDOSE&")";
SPACING←SPACING-PP;
PRINT(CLOSE);
IF SP≠NULL DHEN∪ I%∨$Q% Y' →GeYL_Eπ←]QS]kJ↓oSYX↓MP∪W≤AβOS∂#↔7↔w!9 $hP$'↔STATEMENT WILL BE FLUSHED"&CRLF);
WHILE ¬EQU(TOKEN,";") DO GET_TOKEN;
REJECT←TRUE;
NUM_OF_ERRORS_FLUSHED←NUM_OF_ERRORS_FLUSHED +1;
GO TO FLUSH;
β;
BOOLEAN PROCEDURE MODIFY_CONTINUE(INTEGER ERR_NO; STRING MESS);
α ERROR(ERR_NO,MESS);
return(false);
β;
BOOLEAN PROCEDURE MODIFY_FLUSH(INTEGER PP,ERR_NO; STRING MESS);
α F_STATE(PP,ERR_NO,MESS);
return(false);
β;
BOOLEAN PROCEDURE MODIFY_BACKUP_FLUSH(INTEGER PP,ERR_NO; STRING MESS);
α ERROR(ERR_NO,mess);
F_STATE(PP);
β;
BOOLEAN PROCEDURE MODIFY_BACKUP_CONTINUE(INTEGER ERR_NO;STRING MESS);
α MODIFY_CONTINUE(ERR_NO, MESS);
return(false);
β;
REQUIRE "[][]" DELIMITERS;
DEFINE MODIFY_FLUSH_MACRO(str)=[ IF MODIFY_FLUSH(str) THEN GOTO RE_TRY ];
DEFINE MODIFY_CONTINUE_MACRO(str) = [ IF MODIFY_CONTINUE(str) THEN GOTO RE_TRY ];
DEFINE MODIFY_BACKUP_FLUSH_MACRO(str)= [IF MODIFY_BACKUP_FLUSH(str) THEN GOTO RE_TRY ];
DEFINE MODIFY_BACKUP_CONTINUE_MACRO(str)= [IF MODIFY_BACKUP_CONTINUE(str) THEN GOTO RE_TRY ];
! begin_P,end_P, open_paren_P;
recursive procedure begin_P;
α INTEGER SAVE_DEC_NUM,SAVE_MACRO_DEC_NUM,SAVE_DIMEN_DEC_NUM;
INTEGER SAVE_ARRAY_DEC_NUM,SAVE_PROCEDURE_DEC_NUM;
EXTERNAL RECORD!POINTER(ANY!CLASS) PROCEDURE $REC$(INTEGER OP;
RECORD!POINTER(ANY!CLASS) R);
record_pointer(any_class) rr;
STRING B1,B2,E1,E2,TT; STRING S, BLK_NAME, BLK_NAME_END;
STRING UNUSED_S;
IFC DEFIN_PRINT_SWITCH THENC STRING UNDEFINED_S;ENDC
TT←"("&LABL;
B1←B2←"BEGIN";
E1←E2←"END";
BLOCK_LEVEL←BLOCK_LEVEL+1;
SAVE_DEC_NUM←DEC_NUM; DEC_NUM←0;
SAVE_ARRAY_DEC_NUM←ARRAY_DEC_NUM; ARRAY_DEC_NUM←0;
SAVE_PROCEDURE_DEC_NUM←PROCEDURE_DEC_NUM; PROCEDURE_DEC_NUM←0;
SAVE_MACRO_DEC_NUM←MACRO_DEC_NUM; MACRO_DEC_NUM←0;
SAVE_DIMEN_DEC_NUM←DIMEN_DEC_NUM; DIMEN_DEC_NUM←0;
IF EQU(TOKEN,"BEGIN") THEN
α B2←"CO"&B2;E2←"CO"&E2;TT←TT&"$BL";β
ELSE α B1←"CO"&B1;E1←"CO"&E1;TT←TT&"$CO";β;
PRINT(TT);
printout;
GET_TOKEN;
IF TYPE_OF_TOKEN=STRING_TOKEN AND TOKEN_PTR=NULL_RECORD
THEN α BLK_NAME←TOKEN; printout β
ELSE α BLK_NAME←NULL; REJECT←TRUE; β;
SPACING←SPACING+1;
WHILE ¬EQU(TOKEN,E1) DO
α
P_STATEMENT;
if reject=false then GET_TOKEN ELSE REJECT←false;
IF TYPE_OF_RES_WORD≠end_RES
THEN ERROR_REJECT(4,
"Need semicolon before this token ⊂"&TOKEN&"⊃")
ELSE IF EQU(TOKEN,E2) THEN
α
ERROR(5,"Block ends with " & E2 & cr
& "Continue will view as "& E1);
TOKEN←E1;
β;
PRINTOUT;
β;
SPACING←SPACING-1;
BLOCK_LEVEL←BLOCK_LEVEL-1;
GET_TOKEN;
IF TYPE_OF_TOKEN=STRING_TOKEN AND TOKEN_PTR=NULL_RECORD
THEN BLK_NAME_END←TOKEN
ELSE α BLK_NAME_END←NULL; REJECT←TRUE;
ifc dup_file thenc
IF WANT_DUP_FILE THEN
if token=";" then out(channew,";");
endc
β;
! SPACING←SPACING-1;
! BLOCK_LEVEL←BLOCK_LEVEL-1;
IF ¬(EQU(BLK_NAME,BLK_NAME_END) OR EQU(BLK_NAME_END,NULL))
THEN ERROR(600, "Block name at end does not agree with that at beginning.");
UNUSED_S←NULL;
IFC DEFIN_PRINT_SWITCH THENC UNDEFINED_S←NULL; ENDC;
FOR I←1 STEP 1 UNTIL DEC_NUM DO
α STRING SS;
SYMBOL_TABLE[HASH(SS←ID_LIST:NAME[TOP_ID],id_hasher)]
← ID_LIST:NEXT[TOP_ID];
IF ¬USED(TOP_ID) THEN UNUSED_S←UNUSED_S&CRLF& "⊂"&SS&
"⊃ DECLARED ON PAGE "
&CVS(ID_PAGE(TOP_ID))& " LINE "
&CVS(ID_LINE(TOP_ID));
IFC DEFIN_PRINT_SWITCH THENC
IF ¬DEFINED(TOP_ID) THEN UNDEFINED_S←UNDEFINED_S&CRLF&"⊂"&SS&
"⊃ DECLARED ON PAGE "
&CVS(ID_PAGE(TOP_ID))& " LINE "
&CVS(ID_LINE(TOP_ID));
ENDC
TOP_ID←ID_LIST:LAST[RR←TOP_ID];
$REC$(5,RR);
β;
IF LENGTH(UNUSED_S)≠0 THEN UNUSED_S←UNUSED_S&
CRLF & " WERE NEVER USED";
IFC DEFIN_PRINT_SWITCH THENC
IF LENGTH(UNDEFINED_S)≠0 THEN UNUSED_S←UNUSED_S&CRLF & UNDEFINED_S &
CRLF & " WERE NEVER DEFINED";
ENDC
IF LENGTH(UNUSED_S)≠0 THEN ERROR(-1,UNUSED_S);
FOR I←1 STEP 1 UNTIL MACRO_DEC_NUM DO
α
MACRO_TABLE[HASH(MACRO_LIST:ID[TOP_MACRO],macro_hasher)]
←MACRO_LIST:NEXT[TOP_MACRO];
TOP_MACRO←MACRO_LIST:LAST[RR←TOP_MACRO];
$REC$(5,RR);
β;
FOR I←1 STEP 1 UNTIL DIMEN_DEC_NUM DO
α
DIMENS_TABLE[HASH(DIMENS_EXPONENT:NAME[TOP_DIMENS],metric_hasher)]
←DIMENS_EXPONENT:NEXT[TOP_DIMENS];
TOP_DIMENS←DIMENS_EXPONENT:LAST[rr←TOP_DIMENS];
$REC$(5,RR);
β;
FOR I←1 STEP 1 UNTIL ARRAY_DEC_NUM DO
α
ARRAY_SYMBOL_TABLE[HASH(ARRAY_LIST:NAME[TOP_ARRAY],array_hasher)]
←array_list:NEXT[TOP_array];
TOP_array←array_list:LAST[rr←TOP_array];
$REC$(5,RR);
β;
FOR I←1 STEP 1 UNTIL procedure_DEC_NUM DO
α
procedure_SYMBOL_TABLE[HASH(procedure_LIST:NAME[TOP_procedure],procedure_hasHer)]
←procedure_list:NEXT[TOP_procedure];
TOP_procedure←procedure_list:LAST[rr←TOP_procedure]3
$REC$(5,RR);
β;
DEC_NUM←SAVE_DEC_NUM;
MACRO_DEC_NUM←SAVE_MACRO_DEC_NUM;
ARRAY_DEC_NUM←SAVE_ARRAY_DEC_NUM;
PROCEDURE_DEC_NUM←SAVE_PROCEDURE_DEC_NUM;
DIMEN_DEC_NUM←SAVE_DIMEN_DEC_NUM3
PRINT(")");
PRINTOUT;
β;
procedure e`≥Ha v~∀$∩∧@B↓' ≠∪
∨→∨≤↓
∨+≥⊂@ZA≥=∨ v~(∩∪∪ ↓)∨↔ 8zDvD↓)⊃ ≤↓aeS]PPDPRλRv~∀$∪% ∃∃π!?)I+
`,hP$$
Xh(4+¬∪?∂↔'+K∃β␈β↔8cε K↔8E↓l4(HH αεu"⊗≡⊗∩α¬mα≥"J&:8αR⊗6βX4($J α2⊗5!αBε∀*1α~⎇*:⊃↓hαNBεL:"Qα%∩ε:N4*Il4PH&∞⎇ X4(∧M"⊗6Bz⊃! LhP$&↑DJ2¬α≠qAα∩xh($$H⊂4($HJR⊗6¬zR⊗6α2Jεε"CCπK.pc∂HF∪K↔πZIl4(HH&&→∧∩J∞"
⊃u !⊂αR"⊗rα∞}
Yλ4($HJ⊗"N*α&→α∃∩ε"ε⊃i↓% ¬""⊗9∧~}
5λα⊗"N(h($$HHλ4(HH$&B∀J:Q"$*6A%Xh($$HJR⊗6¬z:V2cX4($HH$
lhP$$$≠X4($MαJ&:"BR⊗6αIl4(HJBJ&u">@-G1PPH⊂70hR⊃≥⊗ #∀ λ∞
α0w ∀⊗⊂;t~v2L(∞FEεE≤97qbY:y2P~s (≥CE∧DAλ⊂P$cλ)j j⊃dbg*λ#'jg⊃≥FE∧Bdc⊂(∪ g )U j"fQg*⊂*∩"g⊂(∀$g*∀λ∀⊃∪&⊂a&∪⊃ !dc⊃
P"f)QP()$S*∀⊃∀λ∪& a∪∪⊃∩$Q⊃∀]FB∧Dh&⊂g )j⊂j"fbS*/c S)b]FB∧Dih⊂adg#Wih aRg#UXNFE∧DT "d(∞FE∧DRc⊂"l∀ *,h⊃Mq7w[2L+ S*bP S"⊂"l∀ *,h⊃Myqp[0y∧+⊂d*bFB∧DDj∩"g⊂#ε)j j⊃T_V_L⊗⊃!w[24z4[w0v⊂→7y⊂$Qt be boolean");
GET_TOKEN;
IF ¬EQU(TOKEN,"THEN") THEN
ERROR_REJECT(9,"Missing THEN. Continue will insert it.");
P_STATEMENT;
GET_TOKEN;
IF EQU(TOKEN,"ELSE") THEN P_STATEMENT ELSE REJECT←TRUE;
SPACING←SPACING-1;
PRINT(")");
β;
procedure plan_P;
α ! PLAN STATEMENT FOUND;
LABEL RE_TRY;
GET_TOKEN;
RE_TRY:
IF ¬(EQU(TOKEN,"IF") OR EQU(TOKEN,"WRITE") OR EQU(TOKEN,"ERROR")
OR EQU(TOKEN,"FOREACH")) THEN MODIFY_FLUSH_MACRO([0,11,"Illegal token to "&
"follow PLAN: "&TOKEN]);
REJECT←TRUE;
PLAN_STATEMENT←TRUE;
P_STATEMENT;
PLAN_STATEMENT←FALSE;
β;
procedure while_P;
α ! WHILE STATEMENT FOUND;
PRINT("("&LABL&"$WH");
SPACING←SPACING+1;
P_EXP;
IF EXP_TYPE≠boole_VALUE AND EXP_TYPE≠scalar_VALUE
THEN F_STATE(0,11,"Conditional for WHILE must be boolean or sclar.");
GET_TOKEN;
IF ¬EQU(TOKEN,"DO") THEN
ERROR_REJECT(12,"Missing DO. Continue will insert it.");
P_STATEMENT;
SPACING←SPACING-1;
PRINT(")");
β;
! for_P,case_P,do_P;
procedure for_P;
α RPTR(ID_LIST) POINT;RPTR(DIMENS_EXPONENT)POINTD; ! FOR STATEMENT FOUND;
LABEL RE_TRY;
! ERROR_BUFFER←CURLINER;
GET_TOKEN;
RE_TRY:
IF TYPE_OF_TOKEN=undeclared_token
THEN
α MODIFY_BACKUP_CONTINUE_MACRO([0,"Undeclared variable "&TOKEN&" declared a scalar"]);
POINT←INSERT_ENTRY(TOKEN,ID_TYPE_TABLE);
ID_LIST:TYPE[POINT]←scalar_VALUE;
ID_LIST:DIMEN[POINT]←NIL_DIMENS;
PRINT("($SVAR "&TOKEN&")");
β
ELSE
α POINT←TOKEN_PTR;
IF TYPE_OF_TOKEN≠id_token OR ID_TYPE≠scalar_value
THEN MODIFY_BACKUP_CONTINUE_MACRO([1300, "Need scalar ID here."]);
β;
PRINT("("&LABL&"$FO "&ID_LIST:NAME[POINT]);
POINTD←ID_LIST:DIMEN[POINT];
USE(POINT); DEFIN(POINT);
SPACING←SPACING+1;
GET_TOKEN;
IF ¬EQU(TOKEN,"←") THEN
ERROR_REJECT(14,"Need left arrow here for FOR statement.");
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,POINTD,
"DUMMY variable in FOR statement")
THEN ERROR_REJECT(15,"Need scalar value here.");
GET_TOKEN;
IF ¬EQU(TOKEN,"STEP") THEN
ERROR_REJECT(16,"Need STEP here.");
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,POINTD,
"DUMMY variable in FOR statement")
THEN ERROR_REJECT(15,"Need scalar value here.");
GET_TOKEN;
IF ¬EQU(TOKEN,"UNTIL") THEN
ERROR_REJECT(17,"Need UNTIL here.");
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,POINTD,
"DUMMY variable in FOR statement")
THEN ERROR_REJECT(15,"Need scalar value here.");
GET_TOKEN;
IF ¬EQU(TOKEN,"DO") THEN
ERROR_REJECT(18,"Need DO here.");
P_STATEMENT;
SPACING←SPACING-1;
PRINT(")");
β;
procedure case_P;
α LABEL RE_TRY;
re_try:
PRINT("("&LABL&"$CASE");
spacing←spacing+1;
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(SCALAR_VALUE,NIL_DIMENS,
"index part of case statement")
THEN ERROR(19, "Need scalar value here.");
GET_TOKEN;
IF ¬EQU(TOKEN, "OF") THEN ERROR_REJECT(20, "Need OF here in CASE statement");
get_token;
IF ¬EQU(TOKEN, "BEGIN") THEN ERROR_REJECT(21, "Need BEGIN here in CASE statement.");
GET_TOKEN; REJECT←TRUE;
IF EQU(TOKEN, "[") OR EQU(TOKEN,"ELSE") THEN
α BOOLEAN ELSE_SEEN; ELSE_SEEN←FALSE;
DO α GET_TOKEN;
IF EQU(TOKEN,"ELSE")
THEN IF ELSE_SEEN THEN ERROR(20, "ELSE seen twice in this CASE statement")
ELSE α ELSE_SEEN←TRUE; PRINT (" -1"); β
ELSE IF EQU(TOKEN,"[")
THEN α GET_TOKEN;
IF TYPE_OF_TOKEN≠numeric_token then
ERROR(21,"require an integer number here for numbered case statement");
PRINT(TOKEN);
GET_TOKEN;
IF ¬EQU(TOKEN,"]") THEN ERROR(22,"Need ] here for numbered case statement");
β
ELSE ERROR(24,"Need [ or ELSE here in AASE statement");
GET_TOKEN; REJECT←TRUE;
IF ¬EQU(TOKEN,"[") AND ¬EQU(TGKEN,"ELSE")
THEN α P_STATEMENT;
GET_TOKEN;
IF ¬EQU(TOKEN,";") AND ¬EQU(TMKEN,"END")
THEN ERROR(23,"Need ; or END between statements in a CASE statement")3
β⊂v~∀∩$∩@@@ A+≥)%_A #TQ)∂↔∃≤XE 9λDRv4∀∩∩@@@ε~(∩∪ →M
A ≡∧@A a')β)∃≠ ≥(lA∂ (a)∨↔ 8v~∀∩$∪∪ @∃ #*QQ∨↔ ≤0@vDR↓β∃λ@∃ #*QQ∨↔ ≤0E ≥λλR~∀∩$∩∪)⊃∃≤A ¬I∨$PdPXE]Kα+⊃↓mε∪↔S←,∧Vrπ>L↔&.\]g'~
≥b∧≤~8Rπ∨L≡F.n]nBαKαc"A⊃" h
YU∩3∧λ45*
Ipq3EDQ3Q∧¬,¬FEαyx0qZw3oy\0qtw→β ~@Dv~∧∪AaS]h @ % KX4($≠X4(Q*π⊗@xy0∩≥y2P2≠L(≥FBαα∪aβ∪';Q@∧"B∩mH⊗⊗bd$α%,hIB∩Kαc"A~t⊂0i→Qwtjλ0r3Hul.c!!4ε≤nL=→;,]]∞c!!1y5β∞≠zy-gc"B-≤H≠[nD→<=%∞≠zy-eλU3JI3λ@∀H:42wλ2y97\ 92`*ect(35, "need UNTIL here fkr DLεAgi¬iK@7.sQ1β≡{;S'w+∃β←Lc1β'w≠↔KQ∩Il4(OβK';&{WQlhP'@c,ππβXQ!∀L2λ[¬↓EK~∧)↑-⎇vf)
h∀e,Tλ∀t"λ[¬↓EK~∧)←<<⊗f∂!
d EXQPPH~I∧,Rλc¬≥$~HRCαF¬B∀tXXB∧
λ)t|@⊃03Dλ6∀∀HZtr3id⊂3@λIkKKJYU∩3∧
u⊂5λYαbg*λ∀X
SPACIJG←SPACING)1;
prinp("$@ %@1Q Oπ-≥g&←↑@∞aQ@nc!β⊂Dvw]2L(⊗_pεfi@`1 I@,s≠'`E↓l4(hSCK?≤∧V'<Y(
]⎇Y&
πc"B!⊂H⊂ (∃)∀$bε&$ij
P('dS*≥P⊂H&gk"H)j j⊃d¬ENT FOUND;
H β¬∃_A%
a)%2v4∀∩&<*PbR|Z⊗9@1Q M∀S
E∃K!Q HL_d¬%MλS∧|F⊂
'Rbg≠ID_TOKEH A∨HA∪λE"fB∀]"Jε:α3¬$ JXPhP⊃∀α¬$α⊃3D 3q∩(k&⊂P(→u0λ ⊂dπN@)%≥+
⊃5βπ%≡!6b`%b∩;↔↔ β∪Kπn)α&⊃∧C↔K∃p∩u%@1Q HN≤dε/∂U
D`9q3C∧!( i∩Q∀P'T⊂"`⊃U(T@∨↔∃≤XE3Aβ%⊗DαH4(⊃⊃∃$DY`λ Yβb$c⊗L! aRh¬P_COH
)∪9+
1≠¬π%≡QlbrXEe←jAGα 9∂Q∧¬V␈6T∧"7&⎇<VrHHλ$∀((W%↔c"B!_u0 )⊃e*_FRAME←TO@↔ 8v~∀∩%!%∪≥PPDPDα22ε
b1↓$β3h∧$β*'eQg∀]FBα SPACANG←SPACIH
∞Vβ d4λHJ&→,~",93∧t4⊂
∃'` EN(10∩Y9+⊂∩ED%$z%∀¬$DY`λ
(2Q0jKβj)*Q]FE∧BhλλEXP;
IF ¬@π⊃ π,1 "↓BRfB)B∩&6,rM#S⊗ ;L@λh∀e,UHDM≥H→d )λI∀l,j5Bα∀h∧P)X(⊃0≤≤92y`3iof"$~∀$HJR"⊗p∧∧-∃)z!E∀Y(T≥λλ 0,"Fe@∃HAKRπ##↔I∧∧∩∧∃(→T*ε|∧@⊂∃) g)Q'i&@ exprepπgS←8AQKe∀\DRv4⊂ ∧$MαJ&:αIu-#1Q HMβλ4d
X∧q*7c"B!_u0 )⊃dεT1→%β≠ ⎇]`↔3cX4(∧M~Bε∞Lr≡nN∧
ε&:8iEl4PH&BJLrQ! J⊃%l4PH$
lhP4+C⊗{∂π∪,ε&*ε≤h M∨ε≤∞aQ@ @⊂∀h∧RINE SAVE1,SAVA2,TRANS; RP@)HQ∪λDb&NQJαB>→jCXh!∀∩∧ hi∃B¬8¬⊂*H313JD⊃Su)@
RE_TRY:
IF TYPE_OF_TOKEN≠ID_TOKEN OR ID_TYPE≠TRANS_VALUE
THEN α MODIFY_BACKUP_CONTINUE_MACRO([19,"Need frame ID here for affixment."]) ELSE
POINT←INSERT_ENTRY(TOKEN,ID_TYPE_TABLE); β
ELSE POINT←TOKEN_PTR;
DEFIN(POINT); AFFIX(POINT);
CURRENT_FRAME←SAVE1←TOKEN;
IF ¬CHECK_NEXT_TOKEN(21,NULL,"TO") THEN REJECT←TRUE;
GET_TOKEN;
IF TYPE_OF_TOKEN≠id_token
THEN POINT←ERROR_REJECT(13,"Need frame ID here for affixment.")
ELSE α POINT←TOKEN_PTR; IF ID_TYPE≠trans_VALUE THEN ERROR(19,"Need frame ID here."); β;
! IF ¬DEFINED(POINT) THEN UNDEFINED_VAR; ! COMMENTED OUT FOR ARG;
AFFIX(POINT);
SAVE2←TOKEN; GET_TOKEN;
BY_FLAG←AT_FLAG←RIGID_FLAG←FALSE;
BY_S←AT_S←RIGID_S←NULL;
WHILE ¬(BY_FLAG AND AT_FLAG AND RIGID_FLAG)
DO α INTEGER J; STRING S; J←1;
FOR S← "BY","AT","RIGIDLY","NONRIGIDLY"
DO IF EQU(TOKEN,S) THEN DONE ELSE J←J+1;
CASE J OF
α
[1] α IF BY_FLAG THEN ERROR(100,"double BY variable")
ELSE by_flag←true;
GET_TOKEN;
IF TYPE_OF_TOKEN≠id_token
THEN POINT←ERROR(13,"Need trans ID here for BY in affix statement.")
ELSE
α POINT←TOKEN_PTR;
IF ID_TYPE≠trans_VALUE
THEN ERROR(19,"Need trans ID here for BY variable in affix statement.")
ELSE IF block_level_of_defn=0
THEN ERROR(25,"You are using predeclared variable in BY part of affixment");
β;
! IF ¬DEFINED(POINT) THEN UNDEFINED_VAR;
BY_S←TOKEN;
GET_TOKEN;
β;
[2] α IF AT_FLAG THEN ERROR(19,"Double AT variable")
ELSE AT_FLAG←TRUE;
P_EXP2; AT_S←OUTEXPR; GET_TOKEN;
β;
[3] [4]
α IF RIGID_FLAG THEN ERROR(21,"Can only specify rigid or nonrigid affixment once")
else rigid_flag←true;
RIGID_S←TOKEN; GET_TOKEN;
β;
[5] α IF ¬EQU(TOKEN,";") AND ¬EQU(TOKEN,"END") AND ¬EQU(TOKEN,"COEND")
THEN ERROR(22,"Cant use ⊂"&token&"⊃ in this affixment statement") ELSE REJECT←TRUE;
IF ¬AT_FLAG THEN α AT_FLAG←TRUE; AT_S←"()"; β;
IF ¬BY_FLAG THEN α BY_FLAG←TRUE; ! BY_S←T_GEN;
! pRINT("($TVAR "&BY_S&")"); by_S←"()";β;
IF ¬RIGID_FLAG THEN α RIGID_FLAG←TRUE; RIGID_S←"RIGIDLY"; β;
β
β;
β;
PRINT("("&LABL&"$AFFIX "&SAVE1&" "&SAVE2&" "&BY_S); SPACING←SPACING + 1;
PRINT(AT_S&" "&RIGID_S&")"); SPACING←SPACING-1;
CURRENT_FRAME←NULL;
β;
procedure unfix_P;
α STRING SAVE1; RPTR(ID_LIST) POINT; ! UNAFFIX STATEMENT FOUND;
LABEL RE_TRY;
RE_TRY:
GET_TOKEN;
IF TYPE_OF_TOKEN≠ID_TOKEN OR ID_TYPE≠TRANS_VALUE
THEN α MODIFY_BACKUP_CONTINUE_MACRO([19,"Need frame ID here in unfix statement."]) ELSE
POINT←INSERT_ENTRY(TOKEN,ID_TYPE_TABLE); β
ELSE POINT←TOKEN_PTR;
IF ¬DEFINED(POINT) THEN UNDEFINED_VAR;
IF ¬AFFIXED(POINT) THEN UNAFFIXED_VAR;
CURRENT_FRAME←SAVE1←TOKEN;
IF ¬CHECK_NEXT_TOKEN(20,NULL,"FROM") THEN REJECT←TRUE;
GET_TOKEN;
IF TYPE_OF_TOKEN≠id_token
THEN POINT←ERROR(13,"Need frame ID here in unfix statement.")
ELSE IF ID_TYPE≠trans_VALUE
THEN ERROR(19,"Need frame ID here.");
IF ¬DEFINED(POINT) THEN UNDEFINED_VAR;
PRINT("("&LABL&"$UNFIX"&" "&SAVE1&" "&TOKEN&")"); CURRENT_FRAME←null;
β;
! signal_p, wait_p;
procedure signal_wait_P(string ws);
α LABEL RE_TRY;
GET_TOKEN;
RE_TRY:
IF TYPE_OF_TOKEN≠id_token OR ID_TYPE≠event_VALUE
THEN MODIFY_BACKUP_CONTINUE_MACRO([19,"Need event ID here in a SIGNAL or WAIT statement."]);
PRINT("("&LABL&"$EV "&TOKEN&WS&")");
DEFIN(TOKEN_PTR);
β;
procedure signal_P;
signal_wait_P(" +"); ! SIGNAL STATEMENT FOUND;
procedure wait_P;
qignal_wait_P(" -"); ! GAIT STATEMENT FOUND;
! when_P;
IFC FALSE THENC
procedure when_P;
α RPTR (ID_@→∪M(RA!=∪≥(v↓'!%∪9∞A-βHXAβ→M≡1∨ 0Aπ⊃∞a→β∧v4∀∪¬∨=→ β≤↓) ≠ l@A→β _A%∀1)%2l~∀∩B↓/⊃ ≤↓')β)∃≠ ≥(↓
∨+≥⊂v~∀∪≥ (!)=↔ ≤v4∀@@@↓%
1)I2t~∀%∪ @ ∃#*Q)=↔ ≤X π⊃β≥≥∪≥∞D$A)⊃ 8~∀α∪∃%%∨$a% ∃
(Pf`0E≥KK⊂Ao←e⊂Aπ⊃β9∂∪≥∞αβ#↔K*β≠/Iε α↑",qα∞" r≡&:8βOSπ&+7↔;"q _4PH$% αα∂?;&K;W∃∧εvNfD
⊗w≡↑.BεOE`"KXQ!∀<-A
D|\Yc0hPα21D
⊗4⊃# qF∃ @ebg≡]w22a[0y2rε:7ur[⊂*$"S⊂&gb∩c,D!⊂ae`∃P_C@∨≥Q∪∃+
a≠βπ∀y"mMλ¬B∃.lLV6NlX ∧ 1λW%↔c"B*h4Wu yq3@≥H#bj ∃'abg∞FE∧dQ⊂"`⊃U(TGKEN,"ALSO")
λ THEN ALSO1=!>Eβ1'≡1 <D∩∀∩A →'∀A∪ A∃#*Q)=↔ ≤X ∨≤OP@R4PI↓↓↓¬""⊗9∧
2N<β u¬z(→E≤yλItruλC!!(λλ∧λ3∀q$ 1H⊃*~*∃∪i83KλIYS⊗(E⊃"B(∧∧λλλ
I⊃3@⊂λ f)gF'h/Q⊂d∧SO_Lπ∃→2λ~∀%α↓↓↓↓∧*2N∃∧j>∩ε5Hb∞≡u"&*V)B6ε∞α)rE[6 ∧$r6"Ypp ALSO1= E:Rl~∀&<*PbR|Z⊗9@1Q LLdT-
U
D`9q3C∧λ⊃h@∀H*$"gλ"i)'T )"e⊃aj∀→LV⊃'2Yr⊂"'H42y2K⊂⊂!g[:4w:YP;tf≠⊂4w9Yy:⊂$]↔⊃∀]CE GET_TOKEN0⊗~(∪∪ AQ3!
1= 1)∨- ≤7S⊂1i←W∃\∩∀∩A)↓ 8A) ≠A? ∩J,(4(¬αα⊗ %8T∧L2 _AE%~λSn≡β
F∞⊗]C¬$ JXRh!∀αααλ¬∩λYH⊂
"Sh/c S)bFEλP∨←←O←]P⊂λ⊂"f)QP F ID⊂DYPE0≥o=eP∪⊂β
d @∃1#!!(λλ∧∧λ⊂
$⊃g
α ERROR(∪4,"Can only handh JA
⊂1 β _AQ∃aJ\@↓π←]i%]cJAβ;#'∪*β∪↔∪,εF*πM
↔4≠_8L]λπ⊃∧NFA∧Pλ⊂⊂⊂⊂∃"fh/U)*b]CEP⊂λ⊂⊂⊂↓CEP⊂λ⊂⊂⊂"S)bP*⊃dh ∨TRUE;
λ IF TEM@
λ∧∩@AQ⊃ ≤~(∩@@∧↓∞"≤Dbε
}!B≡⊗9XαBJ&u!! !$~"≡H_"α∩h9∧9Dβ⊂0DdJ(J'P)"e⊃aj/j∀*bUFB∧P⊂!R g#bT $"`Q/ad#F& a∪λ⊂!d#H⊃_
β
λ∧∩@A∃→'
~(∩@@∧↓∞"≤β D ∃zIt\,dε`⊂⊃bj_TMKENl~∀%αα&→α-
U"R|Z⊗9⊃∪Q∩Hβ"B$∧λλ∃ λ3HD
⊃34 zα)*bNβ CHAN@∂ ∧a⊃⊗ε%z∞"≤β D ∩d ∧9⊃hλGP↓FEαP⊂⊂⊂⊃d∧SE α REJECT←TRUE+ PRINT("($"&ALSO_OP&" "&VAR D@λMπ↓∞a→β∧LλRDRvα
l4PI↓
Xh &&2αR⊗6h ⊂J∧
DD,aQ Jα ¬¬∀→jBB∩∧@"4 J9qD⎇∧d"α∩jh∃∩Kαb4jλ0r3H{tt⊂(→3Qbf↔h⊂ε
:⊂5⊃)X3UεaQ@(λ
~⊂0r)Hβoih⊂a`g#KX]P(∀$g"∀λα)")≠
∩@εv~∀$εv~∃∃≥∩ hP1∧''+7@BβX4(4UβK ><XG/⊗T G.oβ
βXh!⊂"¬∃λ¬∀D¬⊂∧b ∪$ij) P@∨∪9(vAπQ%∪≥∞αα&∩NαJ$L@Qh
FB∧PP"∃d¬P STATEMEJT FLπ#≥λβX4(→_E≥∀R3H{{]0⊗≠≥P#bU *'eQg_
IF ID_TIPE=wo@IQH"αh∀e,T↓P@!(λ∃ λαg⊂(∀$g ∀ @ ! 4bε
Dd"∧⊂Q∀⊂εTOKEH LDαI∩λβ"BH⊂"f)QF@
α~∀ @A ≡∧⊂∀!∀αααDSTRING&" "&TOKEN;GET_TOKEN;
IF ¬EQU(TOKEN,"IN") OR TOKEN≠";"
THEN
α IF TOKEN≠","
THEN ERROR_REJECT(36, "Need comma or IN or ; here. Continue will insert it.");
GET_TOKEN;
β;
β
UNTIL EQU(TOKEN,"IN") OR EQU(TOKEN,";");
IF EQU(TOKEN,"IN")
THEN
α GET_TOKEN;
IF ID_TYPE≠world_VALUE
THEN ERROR(37,"Need a world ID here.")
ELSE IDSTRING←IDSTRING & " " & TOKEN;
β;
PRINT ("("&LABL&"$PVL "&IDSTRING&")");
β;
β;
! assert_P;
IFC false thenc
procedure assert_P;
α RPTR (ID_LIST) POINT; STRING IDSTRING,COM;INTEGER VAR_TYPE;
! ASSERT OR DENY STATEMENT FOUND;
COM←TOKEN; GET_TOKEN;
IF EQU(TOKEN,"FORM")
THEN
α IDSTRING←null; GET_TOKEN;
IF ¬EQU(TOKEN,"(")
THEN ERROR_REJECT(37,"Need left paren here. Continue will insert it.");
WHILE ¬EQU(TOKEN,")")
DO α
GET_TOKEN; IDSTRING←IDSTRING&TOKEN&" "; GET_TOKEN;
IF ¬EQU(TOKEN,")") AND ¬EQU(TOKEN,",")
THEN ERROR_REJECT(38,"Need either comma or right paren here."&
" Continue will insert a comma.");
β;
GET_TOKEN;
IF EQU(TOKEN,"IN")
THEN
α GET_TOKEN;
IF ID_TYPE≠world_VALUE THEN ERROR(39,"Need world ID here.");
PRINT("("&LABL&COM&" ($SF "&IDSTRING&") "&TOKEN&")");
β
ELSE α REJECT←TRUE; PRINT("("&LABL&COM&" ($SF "&IDSTRING&"))"); β;
β
ELSE
α STRING VAR;
! ?????; IF TYPE_OF_TOKEN≠ID_TOKEN OR ID_TYPE>trans_VALUE
THEN
α ERROR(40,"Need variable ID here.");
POINT←SYMBOL_TABLE[HASH("GARB_ID",id_hasher)];
β
ELSE POINT←TOKEN_PTR;
VAR_TYPE←ID_TYPE;GET_TOKEN;
IF ¬EQU(TOKEN,"=")
THEN ERROR(41,"Sorry, can only handle equality right now.");
PRINT("("&LABL&COM&" ($AF "&VAR&" = "); SPACING←SPACING+1;
P_EXP; SPACING←SPACING-1;
IF VAR_TYPE≠EXP_TYPE THEN ERROR(42,"Types don't match on equality test.");
GET_TOKEN;
IF EQU(TOKEN,"IN")
THEN
α GET_TOKEN;
IF TYPE_OF_TOKEN≠ID_TOKEN OR ID_TYPE≠world_VALUE THEN ERROR(39,"Need world ID here.");
PRINT(") "&TOKEN&")");
β
ELSE α REJECT←TRUE; PRINT("))"); β;
β;
β;
endc
! on_P, reference_P,deproach_P;
procedure on_P;
α RPTR (ID_LIST) POINT;
! CONDITION MONITER FOUND;
BOOLEAN ICMT;
ICMT←INSIDE_CONDITION_MONITOR;
ifc false thenc IF ¬EQU(LABL,null)
THEN
IF LABEL_TYPE≠cm_label_VALUE
THEN
α
ERROR(43,"Must have condition monitor label if any label is uesed. Continue will flush label.");
LABL←null;
β; endc
INSIDE_CONDITION_MONITOR←TRUE;
IF EQU(TOKEN,"ON") THEN P_CONDITION(0,"( "&LABL&"$ON +")
ELSE α CHECK_NEXT_TOKEN(27,null,"ON"); P_CONDITION(0,"("&LABL&"$ON -"); β;
SPACING←SPACING+1;
GET_TOKEN;
IF ¬EQU(TOKEN,"DO") THEN
ERROR_REJECT(45,"Need DO in condition monitor statement. Continue will insert it.");
P_STATEMENT;
INSIDE_CONDITION_MONITOR←ICMT;
SPACING←SPACING-1;
PRINT(")");
β;
IFC FALSE THENC
procedure reference_P;
α RPTR (ID_LIST) POINT; ! NEW WORLD DEF;
GET_TOKEN;
IF ¬EQU(TOKEN,"POINT") THEN
ERROR_REJECT(46,"Need POINT here for a REFERENCE POINT statement.");
GET_TOKEN;
POINT←CHECK_ENTRY(TOKEN,ID_TYPE_TABLE);
IF POINT=NULL OR ID_LIST:TYPE[POINT]≠world_VALUE THEN
ERROR(47,"Need a world variable here.");
PRINT("("&LABL&"$NW "&TOKEN&")");
β;
ENDC
procedure deproach_P;
α string ss; ss←"("&labl&" $ASSERT ($SF DEPROACH "; get_token;
IF ¬EQU(TOKEN,"(") THEN ERROR_reject (47, "need left paren after deproach");
get_token;
IF type_of_token≠id_token or id_type≠trans_value then
error(47, "only frames can have deproaches, "&token&" is not a frame");
SS←SS&TOKEN;
get_token;
IF TOKEN≠")" THEN ERROR(48, "need right paren here in deproach statement");
get_token;
IF TOKEN≠"←" THEN ERROR(49, "need ← here in deproach statement");
p_exp2;
SS←SS&" "&OUTEXPR&"))"; PRINT(SS);
β;
! open_P,center_P,stop_P,enable_P,disable_P;
procedure open_P;
α STRING HAND; ! OPEN/CLOSE FOUND;
RPTR (ID_LIST) POINT;
check_next_token(48,"Unknown hand in OPEN/CLOSE statement",
"BHAND","YHAND"); HAND←TOKEN;
check_next_token(49,NULL,"TO");
PRINT("("&LABL&"$MO "&HAND);
SPACING←SPACING+1;
P_EXP;
IF ¬CHECK_EXP_TYPE_DIMENS(scalar_VALUE,DISTANCE_DIMENS,
"OPEN/CLOSE statement")
THEN ERROR(121,"Need scalar quantity here in an OPEN or CLOSE statement");
GET_TOKEN;
IF ¬EQU(TOKEN,"WITH") THEN REJECT←TRUE
ELSE α GET_TOKEN;
IF EQU(TOKEN,"NO_NULLING") THEN PRINT("($NNULL +)")
ELSE IF EQU(TOKEN,"NULLING") THEN PRINT("($NNULL -)")
ELSE ERROR(122,"WITH CAN ONLY TAKE NULLING OR NO_NULLING HERE");
β;
SPACING←SPACING-1;
PRINT(")");
β;
procedure center_P;
IF check_next_token(50,"Unknown arm in CENTER statement",
"BARM","YARM") then PRINT("("&LABL&"$CENTER "&TOKEN&")");
procedure stop_P;
α ! STOP FOUND;
RPTR(ID_LIST) R1;
GET_TOKEN;
IF (R1←CHECK_ENTRY(TOKEN,ID_TYPE_TABLE))≠NULL_RECORD
THEN α IF (ID_LIST:TYPE[R1]≠TRANS_VALUE)
THEN ERROR(49, "Trying to stop a non-frame");
PRINT("("&LABL&"$STOP "&TOKEN"")");
β
ELSE α IF TYPE_OF_TOKEN = undeclared_token
THEN PRINT("("&LABL&" $STOP "&TOKEN&")")
ELSE α REJECT←PRUE; PRINT("("&LABL&"$STOP )");β;
β;
β;
pRocedure denable_P(STRING en);
α ! ENABLE/DISABLE found;
STRING S1;
s1← "(" & LABL & " $CMABLA " & en;
GET_TOKEN;
IF ID_TYPE = LABEL_VALUE¬
THEN α S1← S1&TOKEN&" )";↓+'
QQ∨↔ ≤a!)$Rl@ε~∀$∩@@A∃→'
@∧A% ) π)?Q%+
v↓∪ A∪9'∪
aπ∨≥ %)∪∨≤a≠∨≥∪Q∨$~∀$∩@@@A)⊃ 8@A&bαα⎇αM
↓→↓ αIλ4(HI↓↓↓αα⊗"N*α⊗JJ⎇⊃!EI~a↓
?vceβ3∞∪↔1β≡ 9β *βWO↔"β'9α,rε
2*β?Iα$JNε
d)βOS∂#↔7↔w!9 %Xh($%α↓↓↓≠X4($MαJ&:"BME%Xh($$≠X4(4WβK?∂.#WK∃ε+;π f(bAlhP'∪↔v 3∀E↓! ↓Z↓↓%LhP4+C⊗{∂↔∪-∪∃β∪O≠π 3)BAl4PK∪↔l≤&f)
¬α∩αT∧"KXQ!P@bλ≡,W∂.≡,QEβ1Q'π⊗|8V'/,Tπ⊗/≡Y↔⊗)
π0hP⊃⊂"α
(U
,~(R¬≥H~D,lYjB∧4zYd#XQ!⊂Ld_(Tb¬(S¬%∃↔1PPH_xU!EIy4,sαc"A~Q&∃
+.Hβ!!"21D*≤Y.≡:<Y# Y9hβD∃⊗4λS∪qF
(4f∃izQλπ∧∞Y<=-≡Y&→-l
#"A⊃(λλ∧
∩⊃3DH∩1D 3q∩(k&⊃S
Zr
¬F,+λI≥≠→9l≥λ≥≠m<;H_,n→<@
(452*((J(
I⊃3Hλyu∪h
(&∃∀K↔hc!!"(λ∧∧⊃3∀hQ"B"!_p4q$
⊗4⊃# qF∀HZf⊃sj(λ (∞,<=2.,&_Y,t⊃qC!!"" AQsource_file_X] α
integer res_word_sav; string new_file,sav_token;
GET_TOKEN;
new_file←token;
GET_TOKEN;
sav_token←token; res_word_sav←type_of_res_word;
TOP_SOURCE←PUSH_SOURCE_LIST(TOP_SOURCE);
SOURCE_LIST:NUM[TOP_SOURCE]←0;
WHILE ¬ got_input(PRESENT_file←open_new_file(new_file))
DO α ERROR(55,"FILE NOT AVAILABLE");
new_file←infile; β;
CHANIN←file:chn[PRESENT_FILE];
if equ(file:device[PRESENT_file],"TTY")
then
α
CHECK_WANT_COPY;
OUTSTR(CRLF&"Enter input through the keyboard. Terminate with<CONTROL><META><LF>"&CRLF);
β
else
α if typed_page_num then outstr(crlf);
outstr(infile & " 1");
β;
ifc dup_file thenc
IF WANT_DUP_FILE THEN
open_NEW_AL_FILE(PRESENT_FILE, "NEW");
endc
pagenum←linenum←0;
GET_TOKEN;
IF EQU(CURLINE[1 TO 17],"COMMENT ⊗ VALID")
THEN α GARB←READ(SEMICOLON_A_BREAK); get_token; β;
PARSED_STRING←null; curliner←curline;
token←sav_token;
type_of_res_word←res_word_sav;
reject←true;
switch_file←true;
β;
[message_x] α
GET_TOKEN;
IF TYPE_OF_TOKEN≠string_token
THEN MODIFY_BACKUP_FLUSH_MACRO([0,52,"Need string after REQUIRE MESSAGE"]);
OUTSTR(TOKEN);
β;
[error_modes_x] α
INTEGER I,L; STRING S; BOOLEAN T;
GET_TOKEN;
IF TYPE_OF_TOKEN≠string_token
THEN MODIFY_BACKUP_FLUSH_MACRO([0,52,"Need string after REQUIRE ERROR_MODES"]);
L←length(token);
FOR I←1 STEP 1 UNTIL L DO
α S←TOKEN[I FOR 1];
IF EQU(S,"-") THEN α I←I+1;
S←TOKEN[I FOR 1];
T←FALSE;
β
ELSE T←TRUE;
CASE S OF
α
["L"] α COMPILE_LOGGING←T;
IF ¬T THEN LOGGING←T; β;
["A"] AUTO_PROCEED←T;
["F"] STRICT_DIMEN_CHECK←T;
["M"] PROMPT_FOR_MODIFIABLE_ERROR_ONLY←T;
["N"] WANT_DUP_FILE←FALSE;
ELSE ERROR(0,"Error_mode " & s & " undefined. Only modes LAFMN are applicable")
β;
β;
β;
[compiler_switches_x] α
INTEGER I,L,I1; STRING S; BOOLEAN NON_EXIST_SWITCH,BAIL_WANTED;
GET_TOKEN;
IF TYPE_OF_TOKEN≠string_token
THEN F_STATE(0,52,"Need string here.");
L←LENGTH(TOKEN);
FOR I←1 STEP 1 UNTIL L DO
α
S←TOKEN[I FOR 1];
NON_EXIST_SWITCH←TRUE;
FOR I1←0 STEP 1 UNTIL SWITCH_MAX DO
IF EQU(S,SWITCH_NAME[I1]) THEN
α SWITCH_SETTING[I1]←TRUE;
IF I1=B_X THEN BAIL_WANTED←TRUE;
NON_EXIST_SWITCH←FALSE;
β;
IF NON_EXIST_SWITCH THEN
ERROR(0,"Switch " & S & " unknown");
β;
IF BAIL_WANTED
THEN α
IFC debug_compile
THENC OUTSTR(crlf & "BAIL requested"); BAIL
ELSEC OUTSTR("Sorry, Bail not loaded." & crlf)
ENDC;
β;
β;
[bail_X] α
IFC debug_compile
THENC OUTSTR(crlf & "BAIL requested"); BAIL
ELSEC OUTSTR("Sorry, Bail not loaded." & crlf)
ENDC;
β
β;
β;
! dimension_P;
procedure dimension_P;
α "dimen_p"
! DIMENSION STATEMENT FOUND;
STRING DIMEN_NAME;LABEL RE_TRY;
RPTR(DIMENS_EXPONENT) D1;
forward recursive rptr(dimens_exponent) procedure factor;
recursive rptr(dimens_exponent) procedure term;
α rptr(dimens_exponent) r1,R2;
R1←FACTOR;
IF R1=NULL_RECORD THEN ERROR(0000,"invalid expression.");
WHILE TOKEN="*" OR TOKEN="/" DO
α
STRING S; S←TOKEN;
GET_TOKEN;
R2←FACTOR;
IF S="*" THEN R1←MULTIPLY_D@∪≠∃≥'β∨9&Q$b1$dR~(∩∩∩∪∃→'
AHc? ∪Y∪
1⊃∪≠ ≥M∪∨≥&!$bY$HRv~∀$∩∩εv4∀∩∪%∃)+%≤!$bRv4∀∩εv4∀~∀∪IKGkeMSmJAIaidQ⊃S[K]L1Kqa=]K]h%ae←G∃IkeJ↓MCGi=dv~∀$∧AeaQdQIS5K]f1∃qa←]∃]hSdβ 3IIXh($&L1αR≡\*9`*%∧"¬$λYbh!⊃⊂H∩
+z⊃4S'4⊂1H
Irq3C4J(@
I⊃3@λZTStEε ¬D];XL≥_;Xl\λ≤_.,;HB!QB""!⊃9;≤lT→y5β∞≠zy-gc"B!⊃ c"A⊃13∀hT⊂1H
Ipq3DπαP⊃$S+⊃⊂*∩"gεEαDDA GET1Q∨↔ ≤βYα&→¬">.⊗qY↓! ¬""⊗9∧*JJ>∩AAAAαa 6\\Bε␈ ]bπε≡,Vrε≤h
↑H∩3Jeλ≤⊂→≠qrrbλ;tv , insEpt")
ELSE R2←TERM 64∀∩∩∪Hc? ∪Y∪
1⊃∪⊂⊗⊗u~&>j5∧`)3 "∩fbg)K)→∀]CE∧DD@FE∧DQd∧SE α
p∧c >≤B⊗∞,D*:RJJBR>8Ybd$α31)@)` ON_TYPE_TABLE)0⊗~(∩∪∪ ↓`bk≥U→_!%∃π⊂≡J ∧¬$DY`∧-∃)z"Cβεεαb¬Iy4,R∧dα⊗V}@λ L8{_.,9 HE⊃ B"!_3∀q$λq1ε
Ip¬bg∞FE∧D@]FE∧T j*i∪∀)_@);
β;
RE_TRY:
∪∂∃(1)∨- ≤`,hP&&→¬"fB∀Dz_bR|Z⊗8o,s∪↔∂f K↔⊂G#?/↔p∧∧ TDλ$d|93∧d-hYAD|cλD,4dπ0IIprf H5Q3↓Q@(λ
I⊃3@ Yq∩1K∪⊂P0i:αh #∪*id ∪`a`∩O([0,61,"Can only us@∀Ac]e∃g@↔K4∧V"∧_@ nP37`2 dimensioNs( E:αId4λL"&&⊗qB:ε6-zR>8YcXh!Q L<X¬ε
Ip¬bg∞FE∧dQ⊂αbhUT*'eQg∩⊃∞Hα) @)! ⊂→α-∩J>Hβ
$,TX:BC3%D$v.\@λπT~;@⊂⊃$fbg∀dgg≤z0z2[p¬nt8@R`,hP&≡⊗αC¬$|8YcXh!Q L#≠zD-∀Tεc!↓21H
Ip¬bgεQ≥Q THEN↓ %%∨HP```@XE
∃λA' 5∪π>dz9αλZ$*∩↔1P@L_d∧# β3U)Iλ∪tDλα_↑g∩fλλDIMENS THEN
λ∧∩βS9c@↔KαCε.wN/∩D$α31)@ ∞AME(DIMEH
'∪=_1)Mα∀bR ∩2∃$hP$&⊗e~∃α→j4-∃@ε⊃)j∀V*λI313C P31%H⊂∧fbSαS@∪∨81)3!∀1)β¬1
P∩⊃λ¬∪@1 B4HYQ0u zα)*bNFA∧AH⊃24fYw 8⊃∞FEβ⊂Dqz≤4p∞g_P;
id¬FAM¬YgJAβ##↔l1PWπ-xλl\≥<Y$∞⎇≤Z-lf∀∞aQB @⊂βE BOOH β8A≥ .βZJBR⊂¬∧L!α∪∩*:α∀iλNβ @→β _A∀(bRJIX4(→→e≤LHS¬≥∀R3HS⊃⊃0iH4P5 →pπ'j∀*bP≠
IF EQU(TLπ↔ ≤αa
:⊗9BN@%)→d:∩∀
DD,d d-=zJ%,*λYE≤* hU=|h→E≤+1Q L<XC¬$|αq3G1"TQ#
∀V&AQ≠BLOCK_LEVEL
THEN r1←insert_entry(token,id_type_table)
ELSE MODIFY_BACKUP_CONTINUE_MACRO([ 12,TOKEN &" already defined"]);
β
ELSE IF R1=NULL_RECORD
THEN α ERROR( 13, TOKEN &" not defined, will define"); R1←INSERT_ENTRY(TOKEN,ID_TYPE_TABLE) β;
get_token;
if token≠"=" THEN ERROR_REJECT(15,"Need ""="" here, continue will insert it");
INSIDE_STRING_DECLARATION←FALSE;
id_list:body[r1]←string_expr;
id_list:type[r1]←string_value;
β;
endc
! abort_P, note_P,comment_P,speed_factor_P,wrist_P,setbase_P;
procedure abort_P;
α ! PRINT/ABORT/PAUSE STATEMENT FOUND;
IF EQU(TOKEN,"PAUSE") THEN
α
p_exp2;
IF EXP_TYPE≠scalar_VALUE
THEN F_STATE(0,1102,"Need a scalar expression here for a PAUSE statement.");
PRINT("( $PAUSE "&OUTEXPR&")");
β
ELSE α
PRINT("( $"&TOKEN&" ");
SPACING←SPACING+1;
GET_TOKEN;
IF ¬EQU(TOKEN,"(") THEN
ERROR(1104,"Need left paren here, continue will insert it.");
TOKEN←",";
WHILE EQU(TOKEN,",") DO
α
GET_TOKEN;
IF TYPE_OF_TOKEN=string_token THEN PRINT(dquote&TOKEN&dquote)
ELSE α
REJECT←TRUE;
P_EXP;
β;
GET_TOKEN;
IF ¬EQU(TOKEN,",") AND ¬EQU(TOKEN,";") AND ¬EQU(TOKEN,")") THEN
ERROR_REJECT(1103,"Illegal separator. Continue"&
" will try to insert reasonable separator.");
β;
IF ¬EQU(TOKEN,")") THEN
ERROR(1104,"Need right paren here, continue will insert it.");
SPACING←SPACING-1;
PRINT(")");
β;
β;
procedure note_P;
α
BOOLEAN LPAR; STRING T,T2;
LPAR←FALSE;
T←TOKEN;
GET_TOKEN;
IF EQU(TOKEN,"(") THEN α LPAR←TRUE; GET_TOKEN β;
IF TYPE_OF_TOKEN≠string_token then F_STATE(0,1102,
"Need string expression here for "& token & " statement.")
ELSE
α T2←TOKEN;
IF LPAR THEN α GET_TOKEN; IF ¬EQU(TOKEN,")") THEN ERROR(1234,
"Parenthesis mismatch.") β;
PRINT("( $"& T & space & dquote & T2 & dquote & " )");
β;
β;
procedure comment_P;
GARB←READ(semicolon_A_break);
procedure speed_factor_P;
α
GET_TOKEN;
IF ¬TOKEN_EQU("←") THEN ERROR_REJECT(37, "Need ← here");
p_exp2;
IF EXP_TYPE≠SCALAR_VALUE THEN ERROR(36, "Need to have scalar expression for SPEED_FACTOR");
PRINT("($SPEED_FACTOR "&OUTEXPR& " )");
β;
procedure SETBASE_P;
PRINT("("&LABL&"$SETBASE)");
procedure WRIST_P;
α
GET_TOKEN;
IF ¬TOKEN_EQU("(") THEN ERROR_REJECT(37,"Need ( here");
GET_TOKEN;
IF TYPE_OF_TOKEN=ARRAY_TOKEN AND ARRAY_TYPE=SCALAR_VALUE
THEN BEGAN
PRINT("("&LABL&" $WRIST "&TOKEN&")");
GET_TOKEN;
IF ¬TOKEN_EQU(")")THEN ERROR_REJECT(37,"Need ) here");
end
else error(45,"Need scalar array as argument of WRIST");
β;
! define_P,declare_P,globalλP,procedure_P,return_P;
procedure defIne_P;
if ¬eacro_handler then goto FLUSH;
rclass tstack(rptr(id_list,array_list)ptr; integer isid; rptr(tstack)next);
rptr(tstack) tstacktop,tstacktemp;
procedure pus@!igiC
VQeaQdQSHaYSghαcπKK∂Hc3'∨!'KIX∧εNwL\v/∩
≡6N"↔1P@⊂≡N7&∞=>F.o yf/9∞,V≡␈,Eπ'∨L≤6ZK1Q O'>L⊗≡[.∞G∃←N>F∞≡>LVo¬Y}'β←N>F∞≡7-↔=9⊗⎇∞>_8znL;<↔+⎇<z9π1"B=∞>_8zg-Y>≥ >≤⎇_,=⎇→;. 7⎇≤nL8z⎇
}∞c"A≡≤⎇_,=⎇≠| }≤⎇_,=⎇→;.πc"@g1"C"L-{{→,≥H≤∀M|y9≥.,(→R-l~;]∞>_8ze∞⎇≤Z-lh≥≥¬↔c"@A≡\≥≤E∞α9z0XuTz2[x≥FEαz2vx↔z9z0Xuz7x∞FE∧{Z4v2P≥2vx
[:v6 ≤2qwy→⊂27FB∧P⊂↓λ4s⊂:≤z0quN4ytr⊗z2vx↔P:42[εE∧D@⊂4s⊂→xzT:≥⊗4r ≠4yz≥≠0vrm]9z0qZ]8:9⊗z2vx↔nTP*~2w⊂9→z:y7
:9:rJ]P↓FB∧Drf≤pP4cλ2xzT≥:⊂ array_list:name[tstack:ptr[temp]]) then retp e\!iekJ$v~∀∩@@Ai∃[a?iMiCGVi]KqimiK[atv~∀∩@εv~(∪eKiUe\QM¬YgJRl~∀εv4∀~∃e∃GkegαK[∃β¬∪?∂↔'+K∃β&+∂3π⊗)HbAG∪↔≠↔⊗+;∂∃π≠SK'v9β∪↔→COSKNs∃mβ⊗+≠↔K.s∂¬βNsS↔∨,ε"εF}sεn∞o↔0hP≡.π'∩ M⊗n.n3ε/G
⎇f.wE_FNi∞∞G∪Z
≥g&.|Z"π'≡ S
f-M6g6β
.aQ@B2-n→9y.$≥≡< VNh_M⎇{→8-d≤x=LS~;\m≤→&→ \{_<C∞∞c"A≡x=P∩F4w9tY2L22Xv0y ≤/tw9Zp2L2→qv0y→L8≥FB∧tw9Zp∧e_declare_P←@QekJv4∀∪SL↓isaJD{@≠K∞k∀c[∞cW∃β&C↔9β'KC∃J␈#@⊗∞n3π6∞NXRε.N8 $∞≡<⊃&+⎇≡< V,c"A≥9H⊂∩\zT:7Zp¬n,"ARRAY") then~∀$@@∧@ CeeCdAYSgPD~∀∩Agie%]NAgLrAeaQ`QCeICr1Y%ghSCAidvA%]aKO∃dAR`1RbvA$c?Ra|`v~∀$@ACaβ#J␈;.c0cK.≠?K⊃Xβ@∨≥t$D
∀≠∀α∩⊗L\1Fv≥\U←'≡λ &≠)HH∧'c"B$∧→≠h$λ[≠m⎇h→[n$≥X;
≤λ~9∧! B(∧∧λλ→l↑ε≥≠m<αw≥FB∧P⊂⊂λ⊂4s⊂≥<x2L≠s :7Zrw≡y→yry;→r :7Zrw⊂εB∧Dz4→w⊂&gQ$c,L⊂ aejT #&*Td∀_⊗ X__F≥7urw ⊃⊂4yH0P92\p¬rv@∃HAo←IHAC]⊂A[Cr↓]←hA JAkgα+⊃βπrβπ9βN#↔;SN3'↔Iεsπ7∃∩H4($N+3O∃εK→β f{∂,cf+[↔0F{_c∪,39u@hP$'SF+9β7}#'≠dF∪π∂//c≠3/≠!!Ac→AAIg#?/↔r1 β'~βπ9α aβ∪↔≤cπK↔"β'∪↔w#'≠'/⊃ $4PH'↔3≤)β'→ε∪3/∂YC3↔[.`c?_F#↔≠9n∪3/36aβ?Iε3';∪NsSOS∞≠-#S}[↔9$hP%↓↓α↓↓↓↓π##↔9εk?∪'7Hc π≡[W@c6cWO!C↓1MAβ→2R≡\*9↓→α⊃β#π~βπ3K. ∪eβ⊗+↔9β&+∂3π⊗+⊃ $hP$'↔g≠∀4(HH ↓ 6{W;⊃π≠W'S∞∪3∃βN! β'w#↔∨↔⊂β;≠',c∪Mmεs≠'↔f#N⎇AXh($¬αβON␈∨→≠S?↑+9→ αA l4PH%↓β∂∪KπdFc'OQVsπ7⊗↑ CSJ}s↔\c⊗+∂?K"CπKK∂Hc3'∨!&v␈&{/↔9Xh($%αβπKK∂Hc3'∨!k∪'n+:oπ∧εG∃m|M⊗iG∞N#Xh!⊃∩αε≡.&∂I
M↔∨#.O↔ε-αx<∞NW7⎇∂≡→,@≥CE∧DPλ0y90↑L64y]≥167XuL6"]2v 7Y 22s≠-px 4r]←blklvl;
pushtstack(ap@QdYMC1gJRv4∀∩∩@↓OCh1Q←WK\l~∀∩∩ARa>@v~∀∩$@ASL↓i←WK86E6D↓iQK\↓[←IS→r1EC
Wk`1→YkgP `Xf`@bXE]∃KHA6↓M←dA⊃KYS[%iS]N↓MSKY⊃fA←L↓CeeCdAIKG1CeCi%←\DRl~∀∩∩AI↑@λ~∀∩∩@@A`aKq`dl~∀∩∩@@AG!KGV1∃q`1ieaJ1I%[K]f!gGCY¬d1mC1kJY]%X1IS5K]fX4∀∩∩∩ YS[SQfA←L↓CeeCdASIK9iSMS∃dAoQ%GPAg!←kYH↓EJAC8Ak]I%[K]g%←]KH↓gGCY¬dAKqAeKgg%←\DRl~∀∩∩@@AgM?gfM=kiKqAdv~∀$∩@@@↓OKh1Q←WK\l~∀∩∩@@AS_Ai←W∃\6DtλAiQK8A[←I%Mr1E¬GWk`aMYkg P`Xf@`dXE9KKH@hAi↑AMKaCe¬iJAi!JAeC9OKfA=LAiQ∀ACee¬rAYS5SifD$v~∀∩$@@@A@1Kq`Hv~∀∩$@@@A
QKGVaKq`1QsaJ1⊃S[K]LQgGC1Cd1m¬YkJY9SX!I%[K]f0~∀∩∩$EYS[%ifA←_ACee¬rASI∃]iSM%KdAo!SGPAMQ←kY⊂AEJA¬\Ak]⊃S[K]MS←]K⊂AgGC1CdAKaaeKgMS←\D$v~∀∩$@@@A≥Kh1i=WK\v↓]MSK1Ig?]→SKIILVbf~(∩∩@@Agg?MfLD@λM←ki∃qadvαβ%B␈K↓-E@1Q Jα∧∧ααα∧∧ααα
≤bπ&⎇<VqZ+T"ε∞l@π&}<]aZ∩D λ∞M→;@⊂≠wr4c≡L10qZzx 3≠8¬sh(0,3003( "need , or ] here in array declap¬CiS=\DRv4∀∩∩@@@εAU]iSX↓i←WK8zE:D array_list:#dimens[aptr]←i0;
β "found suitable id";
get_token;
if token≠";" and token≠"," and not equ(token,"END") and token≠")"
then modify_backup_flush(0,3003,"need ; or , here");
β "look for valid id" until token≠",";
reject←true;
dec_string←ss; how_many←i1;
β "array list"
else α "identifier list"
string ss; rptr(id_list)iptr; integer i1; i1←0;
ss←dec_name[type1]&" ";
reject←true;
do α "look for valid id"
get_token;
if type_of_token=reserved_token
then modify_backup_flush(0,3001,token&" is a reserved word and may not be used an an identifier name")
else if block_level_of_defn=0
then modify_backup_flush(0,3002,token&" is an AL declared identifier")
else if block_level_of_defn=blklvl or findintstack(token)
then modify_backup_flush(0,3003,TOKEN & " has already been declared")
else ss←ss&token&" ";
id_list:name[iptr←new_record(id_list)]←token;
id_list:dimen[iptr]←dim_ptr;
id_list:type[iptr]←type2;
id_list:block_level_of_defn[iptr]←blklvl;
pushtstack(iptr,true);
get_token;
if token≠";" and token≠"," and not equ(token,"END") and not equ(token,")")
then modify_backup_flush(0,3003,"need ; or , here");
i1←i1+1;
β "look for valid id" until token≠",";
reject←true;
dec_string←ss; how_many←i1;
β "identifier list";
inside_declare_p←save_inside_declar_p;
β;
PROCEDURE PROCEDURE2_P(STRING DEC_STRING; RPTR(DIMENS_EXPONENT) DIM; INTEGER TYPE1);
α "procedure2_P"
rptr(dimens_exponent) dim2;string procname;
rptr(procedure_list)pptr;
integer type2;string ss,sss;integer totnarg;
if type1=frame_value then type2←trans_value else type2←type1;
if type1=0 then ss← "$PROC " else ss← "$PROC "&dec_name[type1];
get_token;
if type_of_token=reserved_token
then modify_backup_flush(0,3004,TOKEN&" is reserved and may not be used as procedure name")
else if block_level_of_defn=0
then modify_backup_flush(0,3002,token&" is an AL declared identifier")
else if block_level_of_defn=block_level
then modify_backup_flush(0,3003,TOKEN & " has already been declared")
else ss←ss&" "&token&" "; print(ss); ss←null;
procname←token;
get_token;
totnarg←0; tstacktop←null_record;
if token="("
then do
α "arguments in procedure"
integer narg, nn; string ssstoken;
get_token; ss←ss&"(";
if equ(token,"VALUE") or equ(token,"REFERENCE") then
α SS ← ss&" $"&token[1 to 3]&" "; get_token; β;
if type_of_token=metric_token then
α dim2←token_ptr; get_token; β;
if type_of_res_word=declare_res then
α nn←special_info;ssstoken←token; get_token; β else
modify_backup_flush(0,3006,"need a type declaration here");
if nn≠vector_value and nn≠scalar_value and
nn≠trans_value and dim2≠null_record
then modify_backup_flush(0,3000,ssstoken & " cannot take arbitrary dimensions");
if dim2=null_record then
case nn of
α
[scalar_value]
[plane_value]
[vector_value] DIM2←NIL_DIMENS;
[rot_value] DIM2←ANGLE_DIMENS;
[trans_value] DIM2←DISTANCE_DIMENS;
[frame_value] DIM2←DISTANCE_DIMENS;
ELSE DIM2←NULL_RECORD
β;
declare2_P(sss,narg,dim2,nn,block_level+1);
totnarg←totnarg + narg;
ss←ss&sss&")";
get_token;
if token≠";" and token≠")" then modify_backup_flush(0,3007,
"need ; or ) to end argument list for procedure arguments");
β "arguments in procedure" until token=")"
else α ! ss←ss&"()"; reject←true; β;
dec_string←ss;
get_token; if token≠";" then modify_backup_flush(0,3008,"need ; at end of procedure declaration");
pptr←new_record(procedure_list);
if totnarg>0 then
α integer array isid,argmode[1:totnarg]; integer i;
rptr (id_list,array_list) array args[1:totnarg];
procedure_list:#args[pptr]←totnarg;
for i←totnarg step -1 until 1 do
α rptr(id_list,array_list)aiptr;
aiptr←tstack:ptr[tstacktop];
args[i]←aiptr;
if (isid[i]←tstack:isid[tstacktop]) then
insert_entry(id_list:name[aiptr],id_type_table,aiptr)
else insert_entry(array_list:name[aiptr],array_type_table,aiptr);
tstacktop←tstack:next[tstacktop];
β;
if tstacktop≠null_record then modify_backup_flush(0,3009,"PARSER ERROR 3009 NON EMPTY STACK");
MEMORY[LOCATION(ARGS)]↔MEMORY[LOCATION(PROCEDURE_LIST:ARGS[PPTR])]3
MEMORY[LOCATION(ISID)]↔MEMORY[LOCATION(PROCEDURE_LIST:ISID[PPTR])];
β;
insert_entry(procname,procedure_type_table,pptr);
procedure_list:type[pptr]←typE2;
procedure_list:dimen[pptr]←dim;
print("("&ss&")"); printout;
p_statement;
printout;
print(")"); printout;
β "procedure2_P";
procedure procedure_p;
α string ss; PRINT( ("&LABL&" "); procedqre2_p(ss,nil_dimeNs(λ`Rl@εv~(~∃!%=π +I
A
→β%
a v~∀λ∪S]i∃O@↔I¬#gC∃λπ2π↔∞N"F&≥\Vw→ [πε}l]g"NM≥SJπ>N&Nvt∞7~g>>3Zε≥nF.>↑ εF␈⎇\⊗wK1Q O∨N-⊗v:∞8
]<∞c!!9~;+|~;&∞∞≤Nc!! B:,d
≥≡. ,7tn 8z8-C~;YMu&⎇P∩Xz7y ≥0v:`% andqpecIal⊂⊃S9M↑7g
CYCdamCYkα)βπ≠ h($'≥β↔∂'∞`c'≠4¬q←',≥g→Gl≥G.
≥f"εM≥Q↑w]H β∞Y8{n,β"B!≡~→;D
;y~,o&_X,=⎇<ε m≥<r¬ε lεε ≥≠m<;H D∧H_x-m[⎇∞L:y( ≡XZ5∞0y<P→4rrg≤tsw9H∀X
if dim0≠]UYX!e∃G←eH↓iQK\4∀∩∪G¬gBAgAKGSC01S]Mαyβ/_hP$%↓⊂4($J↓↓↓α←≠∂π3∂⊂c[πg+⊗tQ!⊂Jα∧∧¬←εL≥f)Gl≥G.-QQ HJ∧∧α¬←l\7&␈#∞f∞g\[R∧$→[tdL@ε⊃ →13Tg1"B"$∧λλ⊗n-βz ;_v:rnBP⊂⊂"∩fh∂ANGHE_DIIENS;
[trans_value] DIMP∨ %'!β≥
1 ∪5 ≥&v4∀∩α@@A7MIC[J1YCYkKt@A ∪5? ∪'Qβ⊂~∞)B∩&6,rMl4PH%↓α,bN∃α$J6}~,b0bJ,~>J⊂hP$%↓→l4(N;↔Pc&{/.e1P@O>LVo¬t!α∩⊗L≤&b2$∧#@4∀twin8ε6≥CE∧t`& equ(token, "PRMCEDUR@
DR~∀α@@AiQ∃\@∧AAaS]h!giK[@RvAaβ∪?∂↔'+K∃Hβ
αE≥5LFNjNO↔ε+∃↔2_Q!∩αα∧λ -Ny(D
;]→,|αy⊂$Nβ rp@Q` #'!C3'O ¬F∂↔,∨⊃Ff≡>BNO∞N#Xh!⊃∩αα∞N7&∞=>F␈¬⎇nVfa∞,V≡␈,C0hP⊃∀αα∧HX4d
(V!Eαλ∧teI∪us(→T∧V"∩fV*,T XV!∪'aeL∪"k"f
]FE∧BP⊂⊂8≤4w:∀≤z2vx 9yS⊃
Q∀]FB∧DP⊂λ#'i i←1 @MiK`@DAk]i%XAQ←][C]r↓I↑~∀$∩∩∧A%aie?β#OSπ≡YkCSα+7'∨L≤6←&} SXh!⊃⊂Jα
≤bπ'>L⊗≡[-≡6N%>N7&∞=>F␈¬T
FF.d ⊗w≡↑.AF.nN'JF≤CεfO>C&v∞\[6OπN+RfNC∞GOεS∞F∞⊗LUFOπN
!Q@""!≤;≤p∩H4w9r\:λ2g≥9<T0\90p→_list~naee[iptb],array_ty@AJ1iC YJYSAidRv4∀∩∩∩Aigi¬GWi←A?igi¬GVu]∃qa7iMiCGWQ←a:V4∀∩∩∩ v~∀∩$@εv~(εv~∀4⊂
BJ|~⊗∩Vα(R¬∀X¬∃*)F∀∞aQ@B(∞>≤Z;LT≤n`⊂≤ov0q≠≥PεEαpπet_token8εAeKαS↔∂R|εGπ.W1PPN≤dε/∂U∞F}↑]aB'hJ(
}H→4.U≥≠zl]KλQ)hα⊃∀P∪i⊂"hUT*'eQg⊂ "ELSE"
∩∪Q⊃ ≤AA%∪≥(αA↓! 5→→ ↓%∩⊗A↓J⊃$4!⊃∀,@∀q($≤ε→/∞ N`⊂≤94w:
⊃∀⊃β≤S⊃⊂∩∀ j⊂⊃ 5zz2↑89∪⊃
Q∀]@]FEεB↓]FE ! P_statement execution starts here;
LABEL RE_TRY;
INSIDE_STATEMENT←-100;
SAVSPACING←SPACING;
GET_TOKEN;
WHILE EQU(TOKEN,"COMMENT") DO
α GARB←READ(semicolon_A_break); GET_TOKEN; β;
GLOBAL_RE_TRY: SPACING←SAVSPACING;
RE_TRY:
LABL←CHANGER_HEAD; ! USUALLY NULL EXCEPT WHEN INSIDE A CHANGER.;
CHANGER_HEAD←null; LABEL_TYPE←0;
DIM_PTR←NULL_RECORD;
TRY_AGAIN:
CASE TYPE_OF_TOKEN OF
α
[numeric_token] MODIFY_FLUSH_MACRO([0,1,"Statement can't begin with a scalar"]);
[string_token] MODIFY_FLUSH_MACRO([0,2,"Statement can't begin with a string"]);
[macro_token] MODIFY_FLUSH_MACRO([0,3,"PARSER ERROR, MACRO TOKEN FOUND"]);
[metric_token] IF DIM_PTR=NULL_RECORD
THEN α DIM_PTR←TOKEN_PTR; GET_TOKEN; GOTO TRY_AGAIN; β
ELSE MODIFY_FLUSH_MACRO([0,56,"AMBIGUOUS DIMENSIONS"]);
[procedure_token]
α reject←true; p_exp2; print("("&labl&" " &outexpr[2 to ∞ - 1]&")"); β;
[id_token] IF DIM_PTR = NULL_RECORD
THEN
α
IF BLOCK_LEVEL_OF_DEFN≠0 OR TOKEN_EQU("BARM","YARM","BHAND","YHAND")
THEN
CASE (ID_TYPE + 3)OF
α
[LABEL_VALUE +3]
α LABEL_TYPE←ID_TYPE;
IF DEFINED(TOKEN_PTR) THEN ERROR(22,"Label multiply used.");
DEFIN(TOKEN_PTR);
IF EQU(LABL,null) THEN LABL←TOKEN&" " ELSE ERROR(22,"Double label.");
check_next_token(23, NULL ,":");
GET_TOKEN; GO TO TRY_AGAIN;
β;
[form_value +3]
[boole_VALUE +3]
[SCALAR_VALUE +3]
[VECTOR_VALUE +3]
[ROT_VALUE +3]
[FRAME_VALUE +3]
[PLANE_VALUE +3]
[TRANS_VALUE +3]
α STRING ID, AS; RPTR(DIMENS_EXPONENT) ID_DIMEN;INTEGER ID_T,BL;
RPTR(ID_LIST) R1; R1←TOKEN_PTR; BL←BLOCK_LEVEL_OF_DEFN;
ID←TOKEN; ID_T←ID_TYPE; ID_DIMEN←ID_LIST:DIMEN[TOKEN_PTR]; GET_TOKEN;
CASE TOKEN OF
α
["←"]
α STRING SS; GET_TOKEN;
IF ¬EQU(TOKEN,"←")
THEN α AS←"AS ";REJECT←TRUE;
IF ¬BL THEN F_STATE(0,7,"TRYING TO ASSIGN VALUE TO ARM OR DEVICE"); β
ELSE AS←"PAS ";
SS←"("&LABL&" $"&AS&id; P_EXP2;
IF EXP_TYPE=0 THEN OUTEXPR← "( )" ELSE
IF ¬CHECK_EXP_TYPE_DIMENS(ID_T,ID_DIMEN,"assignment statement")
THEN ERROR(121,"Type mismatch on assignment.");
DEFIN(R1); PRINT(SS); SPACING←SPACING+1;
PRINT(OUTEXPR); SPACING←SPACING-1; PRINT(")");
β;
["<"]
α STRING TYPE_CLC,CLC_LAB; BOOLEAN TEMP; ! GAS FOUND;
GET_TOKEN; TYPE_CLC←TOKEN;
IF EQU(TOKEN,"<")
THEN
α GET_TOKEN;
IF ¬EQU(TOKEN,"=") THEN ERROR_REJECT(26,"Need = here. Continue will insert it.");
β
ELSE IF ¬EQU(TOKEN,"=") AND ¬EQU(TOKEN,"≠") THEN F_STATE(0,27,"Bogus assignment.");
GET_TOKEN;
IF ID_TYPE=label_VALUE
THEN
α CLC_LAB←TOKEN; GET_TOKEN;
IF ¬EQU(TOKEN,":")
THEN α REJECT←TRUE; TEMP←FALSE;PRINT("("&LABL&" $"&"GAS "&id&" "&TYPE_CLC&" "&CLC_LAB&")"); β
ELSE TEMP←TRUE;
β
ELSE α REJECT←TRUE; CLC_LAB←T_GEN; TEMP←TRUE; PRINT("($CLCLAB "&CLC_LAB&")"); β;
IF TEMP
THEN
α PRINT("("&LABL&" $"&"GAS "&id&" "&TYPE_CLC&" ("&CLC_LAB&" CLC");
SPACING←SPACING+1; P_EXP; SPACING←SPACING-1; PRINT("))");
β;
β;
ELSE MODIFY_FLUSH_MACRO([0,0,"Can't start this way"])
β;
β;
[string_VALUE +3]
F_STATE(0,2,"Statement can't begin with a string");
ELSE F_STATE(0,4,"Statement can't begin this way")
β
ELSE MODIFY_FLUSH_MACRO([0,7,"Assignment statement can't begin with predefined constant"]);
β
ELSE ERROR(25, "CANNOT HAVE DIMENSION IN FRONT OF VARIABLE");
[array_token] IF DIM_PTR = NULL_RECORD
THEN
α INTEGER ARRAY_T; RPTR(DIMENS_EXPONENT)ARRAY_D;
STRING AS;
ARRAY_T←ARRAY_TYPE; ARRAY_D←ARRAY_LIST:DIMEN[TOKEN_PTR];
REJECT←TRUE;
P_EXP2;
GET_TOKEN;
IF TOKEN = "←" THEN
α STRING SS; GET_TOKEN;
IF ¬EQU(TOKEN,"←")
THEN α AS←"AS ";REJECT←TRUE;
β
ELSE AS←"PAS ";
SS←"("&LABL&" $"&AS&outexpr; P_EXP2;
IF EXP_TYPE=0 THEN OUTEXPR← "( )" ELSE
IF ¬CHECK_EXP_TYPE_DIMENS(array_T,array_D,"assignment statement")
THEN ERROR(121,"Type mismatch on assignment.");
! DEFIN(R1); PRINT(SS); SPACING←SPACING+1;
PRINT(OUTEXPR); SPACING←SPACING-1; PRINT(")");
β
ELSE ERROR(122, "need ← here ");
β
ELSE ERROR(25, "CANNOT HAVE DIMENSION IN FROJT OF VARIABLE");
[undeclared_token]
α STRING ID, AS; INTEGER ID_T;RPTR(DIMENS_EXPONENT) ID_DIMEN;
RPTR(ID_LIST) POINT; ID←TOKEN; GET_TOKEN;
CASE TOKEN OF
α
["←"]
α STRING SS;GET_TOKEN;
IF ¬EQU(TOKEN,"←")THEN α AS←"AS "; REJECT←TRUE; β ELSE α AS←"PAS "; β;
SS←"("&LABL&"$"&AS&id; P_EXP2;
IF MODIFY_CONTINUE(0,"Undefined variablE "&id&crlf&
"Continue will declare it . Modify will allow correction.")
THEN GOTO TRY_AGAIN
EHSE
α POINT←INSERT_ENTRY(ID$ID_TYPE_TABLE);
ID_LIST:TYPE[PGINT]←EXP_TYPE; ID_LIST:DIMEN[POINT]←EXP_DIMENS;
IF EXP_TYPE=Trans_VALUE THEN ID_T←Fraee_VALUE ELSE ID_T←EXP_TYPE;
PRINT("("&DEC_NAMEKID_T]&" "&ID&")")3
DEFIN(POINT); PRINT(SS); SPACING←SPACING+1;
PRINT(OUTEXPR$vA'!¬π∪≥∂⎇'!βπ%≥∞ZblA!%∪9(PDRλRv~∀$∩@@@@@εv4∀∩∩@@@εv4∀~∀∩$@A6DpE2@~(∩∩@@@∧A'Q%∪≥∞ααRfB)B∞"
d~2 bd
mα∀z>"⊗ qαR⊗m↓e↓¬∧:εMα4zV:⊃Xh($%α↓↓αJ¬"I"ε!B2&N ¬∩¬∧y→e#Z
tLuKy∀u≤Z*AD,jJ%JD_ADL!
K∃∧)
H∀∀dU↔0hP⊃∀ααα _ADd~:CU%~λU]∧y→e%m}N&∞w3
d EXW2∧$Xi∀rE y∀u"↔1PPH∀∧αα∧xZAE$βrq)gh⊂
,T"L!f⊂oj'eQg_
IF EQU(TOKEN,"<")
THEN
α↓∂ (1Q∨↔ ≤l~∀α∩%∪ @ ∃#*Q)=↔ ≤XλzDRAQ⊃ ≤A∃%%∨$a% ∃
(Pdl0E≥KK⊂@zAQ∃eJ\@↓π←]i%]kJAβ;'31εK;O↔↔!β'Qr⊃%l4PH$$ hP$%↓α↓↓↓α,bN∃αL1⊗⊗
)"R≡\*91 j⊃%αεt!⊗⊗
)"R≡\*91λZ⊃%αRD*9α_E~RεR*AA1I:a
??+Mβπ∨≠'∨;n+;Q9∩Il4(HI↓↓↓∧:⊗Pb$z.⊗9Xh($%α↓↓α&2α&⊂b%JB∃Wf ↔0E2ε2V(h($%α↓↓↓↓¬""⊗8hP$%↓α↓↓↓∩α∞2 Dbε
}$z.⊗9Zα≡⊗PE">.⊗sX4($J↓↓↓↓αα&→,*FU"$z.⊗9b⊃i %h($$M""⊗8hP$$$∩αJ⊗*,~R}R∃*∃mα$*6B}4
2N∃Xh($$MαJ&:"A ! 4bε
12⊃∩≡ε~↓ ≠'"1 ↓ 5"fB∀D~2
→∩↓ ~∞d_b2ε∩1 % KX4($HH 4(HH&⊗2≤)αR⊗mα}BJ,)l4(HI↓↓↓α↓ 4PH%↓↓α↓↓α⊗e~∃ ¬∩⊗*⊗≥"}RJ,)mα∞d_b2ε∃zPb≡,qmαR,jB}R∃*∃mα¬∩&:QB⊃!∩∞d~2ε α⊃~∞2→B2ε 2⊃% %Z
l4PH%↓↓αα&→α$*6AhP$%↓EN
α PRINT("("&LABL&"$GAS "&id&" "&TYPE_CLC&" ("&CLC_LAB&" CLC");
SPACING←SPACING+1; P_EXP; SPACING←SPACING-1; PRINT("))");
β;
β;
ELSE MODIFY_FLUSH_MACRO([0,25,"Can't start statement this way with undeclared variable"])
β;
β;
[reserved_token]
α INSIDE_STATEMENT←RESERVED_TOKEN_PTR;
IF (statement_beg ≤ TYPE_OF_RES_WORD ≤ statement_end)
THEN CASE TYPE_OF_RES_WORD - statement_beg OF
α
redefine xx(str)=[redefine xx_temp="str" & "_P"; xx_temp;];
redefine yy(str)=[];
redefine zz(str)=[redefine zz_temp="str" & "_P"; zz_temp;];
statement_definitions;
β
ELSE IF TOKEN_PTR←CHECK_ENTRY(TOKEN,DIMENSION_TYPE_TABLE)
THEN α TYPE_OF_TOKEN←METRIC_TOKEN;
DIM_PTR←TOKEN_PTR; GOTO TRY_AGAIN; β
ELSE MODIFY_FLUSH_MACRO([0,3,"Statement can't begin with <"&TOKEN&">"]);
β
β;
FLUSH:
β "P_STATEMENT";
! execution starts here, initialization;
procedure update_break_RS;
α
ifc full_set thenc
SETBREAK(word_R_break, TABLE1, NULL, "INRF");
SETBREAK(word_S_break, TABLE1, NULL, "INSF");
elsec
SETBREAK(word_R_break, TABLE1, NULL, "INRK");
SETBREAK(word_S_break, TABLE1, NULL, "INSK");
endc
β;
α "execution"
RUNTIME←___TIME;
INITIALIZE←TRUE;
COUNT ← 1000; DELIMITER_1 ← "⊂"; DELIMITER_2 ← "⊃";
OPEN_BRACE← "{" ;
TABLE1 ← "⊂⊃%,.;:[](){}+-*/#∧∨¬⊗&≤≥<>≠=←↑→?|" & lf & cr & dquote & tab & ff & space & squote ;
ifc full_set thenc
SETBREAK(
word_R_break ← getbreak, TABLE1, NULL, "INRF");
SETBREAK(
non_blank_break ← getbreak, space & crlf & ff & tab, NULL, "XNRF");
SETBREAK(
word_S_break ← getbreak, TABLE1, NULL, "INSF");
SETBREAK(
non_digit_break ← getbreak, ".0123456789", NULL, "XRF");
SETBREAK(
close_brace_break← getbreak, "}", NULL, "ISF");
SETBREAK(
quote_break ← getbreak, dquote, NULL, "ISN");
SETBREAK(
semicolon_A_break← getbreak, ";", NULL, "IAF");
SETBREAK(
cr_break ← getbreak, cr, NULL, "IANF");
SETBREAK(
paren_cr_break ← getbreak, "()" & cr, NULL, "IANF");
SETBREAK(
lf_ff_break ← getbreak, lf & ff, NULL, "IANF");
SETBREAK(
semicolon_R_break ← getbreak, ";", NULL, "IRF");
SETBREAK(
omit_break ← getbreak, NULL, ";,." & ff & crlf, "I");
SETBREAK(
tty_input_break ← getbreak,ALT,NULL,"IS");
SETBREAK(
knvrt_break ← getbreak,NULL,NULL,"IK");
SETBREAK(
macro_delimiter_break ← getbreak,"⊂⊃",NULL,"IS");
elsec
SETBREAK(
word_R_break ← getbreak, TABLE1, NULL, "INRK");
SETBREAK(
non_blank_break ← getbreak, space & crlf & ff & tab, NULL, "XNRK");
SETBREAK(
word_S_break ← getbreak, TABLE1, NULL, "INSK");
SETBREAK(
non_digit_break ← getbreak, ".0123456789", NULL, "XRK");
SETBREAK(
close_brace_break← getbreak, "}", NULL, "ISK");
SETBREAK(
quote_break ← getbreak, dquote, NULL, "ISN");
SETBREAK(
semicolon_A_break← getbreak, ";", NULL, "IAK");
SETBREAK(
cr_break ← getbreak, cr, NULL, "IANK");
SETBREAK(
paren_cr_break ← getbreak, "()" & cr, NULL, "IANK");
SETBREAK(
lf_ff_break ← getbreak, lf & ff, NULL, "IANK");
SETBREAK(
semicolon_R_break ← getbreak, ";", NULL, "IRK");
SETBREAK(
omit_break ← getbreak, NULL, ";,." & ff & crlf, "I");
SETBREAK(
tty_input_break ← getbreak,ALT,NULL,"IS");
SETBREAK(
macro_delimiter_break ← getbreak,"⊂⊃",NULL,"IS");
TTYUP(TRUE);
endc
WANT_DUP_FILE←TRUE;
! set up input and output;
if rpgsw then
α
cmd_line ← tmpin("AL", eof);
if eof
then α usererr(0, 1, "TMPIN lost"); rpgsw ← false β
else outstr(crlf & "AL: ");
β;
if ¬rpgsw then α outstr(crlf & "*"); cmd_line ← instrl(cr) β;
BIN_file ← new_record(file); ALL_file ← new_record(file);
SEX_file ← new_record(file); T←TRUE;
while true do
α "command" define want_BAIL=[switch_setting[b_X]];
want_BAIL ← false;
if ¬T then α outstr(crlf & "*"); cmd_line ← instrl(cr) β; T ← false;
PRESENT_file←AL_file ← scan_command(cmd_line, BIN_file, ALL_file);
if file:eof[AL_file] then
α usererr(0, 1, "null input spec"); continue "command" β;
file:mode[AL_file] ← 0; file:in_bfrs[AL_file] ← 12; file:out_bfrs[AL_file] ← 0;
file:def_ext[AL_file] ← "AL";
if ¬got_input(AL_file) then
α outstr(infile & "file not found"); continue "command" β;
if file:name[BIN_file]=null
then if file:name[AL_file]= null
then file:name[BIN_file]←"ALMAIN"
else file:name[BIN_file]←file:name[AL_file];
copy_file_record(SEX_file, BIN_file);
file:mode[SEX_file] ← 0; file:in_bfrs[SEX_file] ← 0;
file:out_bfrs[SEX_file] ← 12; file:ext[SEX_file] ← "SEX";
if file:eof[SEX_file] then¬
α "null output spec"
file:device[SEX_file] ← "DSK";
if file:name[AL_file]≠null
then file:name[SEX_file] ← file:nameKAL_file]
else file:name[SEX_file] ← "ALMAIN" ;
β "null output sp@∃FDv~(@@@A%H ↔>{Pc?/#CWQE~⊗`c6K3∃%π##↔_hP$ β/≠↔K↔↔⊃!A1β 1↓ ≡ 9∨Qε;↔Qβ␈+SCW"⊃%mβ≡{;S'w+∃↓ ≡{77πv!
Xh)↓↓αβ?WS6K3⊗␈n /∀c6K3∀cv 7∃"≤*`c≠Nc∃%lhQ↓↓↓∧≠#π;Nqα⎇β6K3∃k≡C:nεaC≠'3-imβ∂F ;?W"α⎇β≠Nc∃k∂FrnN⊗AC≠'3-il4)α↓β'→∧+GU#6K3∃k&+['∂-ZBJ⊗≤*:PC6K3⊗ub∩RRe∩I4)α↓↓↓β&C↔8Q$ααα∧"h$∧ααα
mw9GM}↓F6≥H +}≤]9'1"Hλ∧∧λ⊂rλXrf∃h→Uα⊂iz⊗.c!$λλλ∧
[⎇f∞M|ε→M≥→7p∪_v9r]CE⊂⊂⊂λ⊂'jj∀h)∀!T&#∪⊃⊃w:2iλ4w8:]⊂:49≠zst⊂≥42P5Y|q7p\2↔⊂*→y6tw_z2P 7ith<CONTROL>4META> 91 p→ 4~J2→KX4)↓α↓↓ hQ↓↓↓αβ↔3O(h)↓↓α↓ βL1βSgε+⊂cC∞;∀c;.iβS#.qβ?W'≠SI#∨∪3→%Xh)↓↓α↓β?W'≠SI#Ns≠'3*↓→↓ β %@1Q"αα∧∧∧ D→jE%L{uS XQ$ααα∧3Xh$∧ααπ ≤v.w]Pλ t≠~;L]]; t≤{⎇.1rv;≠⊂/P_∞FA⊂⊂λ⊂:<h→r 8 YrL7:[P/P*≤8r]FB⊂⊂⊂⊂~s1P2→q:sL_wvx$[2P:4→w1P$Yα want_BAIL then BAIL; endc
done "comeand"¬
β comm dup_file thenc
OPEN_NEW_AL_FILE(BIN_FILE, "NEW");
endc
GET_TOKEN;
IF EQU(CURLINE[1 TO 17],"COMMENT ⊗ VALID")
THEN α GARB←READ(SEMICOLON_A_BREAK); get_token; β;
PARSED_STRING←null; curliner←curline;
! set up predefined dimensions, constants, macros and variables;
redefine zz(temp)=[];
redefine yy(temp,temp2)=[
redefine xx_temp= "DIMENS_EXPONENT:"&"temp"&"["&"temp"&"_DIMENS]←1;";
qq(temp)
xx_temp];
redefine qq(temp)=[redefine xxcount=xxcount+1;
redefine yytemp= "temp"&"_DIMENS←NEW_RECORD(DIMENS_EXPONENT);";
redefine zztemp= "DIMENS_EXPONENT:NAME["&"temp"&"_DIMENS]←"&""""&"temp"&""""&";";
redefine xxtemp(xxxcount)=
"D_TABLE["&"xxxcount" & "] ← INSERT_ENTRY("&""""&"temp"
&""""&",DIMENSION_TYPE_TABLE,"&"temp"&"_DIMENS);";
yytemp
zztemp
xxtemp(xxcount)];
redefine xxcount=-1;
metric_definitions;
INSERT_ENTRY("DIMENSIONLESS",DIMENSION_TYPE_TABLE);
VELOCITY_DIMENS←DIVIDE_DIMENSIONS(DISTANCE_DIMENS,TIME_DIMENS);
TORQUE_DIMENS ← MULTIPLY_DIMENSIONS(FORCE_DIMENS,DISTANCE_DIMENS);
ANGULAR_VELOCITY_DIMENS←DIVIDE_DIMENSIONS(ANGLE_DIMENS,TIME_DIMENS);
FOR I←1 STEP 1 UNTIL const_count DO
α RPTR (ID_LIST) TEMP;
INSERT_ENTRY(PRECONST[I],ID_TYPE_TABLE,TEMP←NEW_RECORD(ID_LIST));
ID_LIST:TYPE[TEMP]←PRECONST_TYPE[I];
ID_LIST:DIMEN[TEMP]←D_TABLE[PRE_DIMENS[I]];
DEFIN(TEMP);
β;
ID_LIST:BODY[CHECK_ENTRY("CRLF",ID_TYPE_TABLE)]← "
";
redefine xx(str1, str2)=[
MACRO_LIST:VALUE[cur_macro←INSERT_ENTRY("str1",MACRO_TYPE_TABLE)]←"str2";
cur_macro←null_record;
];
macro_definitions;
INITIALIZE←FALSE;
! PARSE PROGRAM;
spacing ← 0; print("($PR"); SPACING ← SAVSPACING←1; BLOCK_LEVEL←0;
PRINTOUT;
! **********; P_STATEMENT; ! **********;
IF TOP_SOURCE≠NULL_RECORD OR ¬EQU(INPUT(CHANIN,omit_break),null) THEN
ERROR(200,"Misc. garbage found after last end.");
spacing ← 0; print(")"); printout;
ifc dup_file thenc
IF WANT_DUP_FILE THEN
if chanin > -1 then α out(channew,curliner);
while ¬eof do out(channew,input(chanin,0)); β;
endc
! CLEAN UP;
IF CHANIN>-1 THEN RELEASE(CHANIN);
WHILE TOP_SOURCE≠NULL DO
α
IF SOURCE_LIST:CHAN[TOP_SOURCE]>-1
THEN α out(channew, curliner); while ¬eof do out(channew,input(chanin,0));
RELEASE(SOURCE_LIST:CHAN[TOP_SOURCE]); β;
TOP_SOURCE←SOURCE_LIST:NEXT[TOP_SOURCE];
β;
CLOSO(CHANOUT);
CLOSO(CHANLOG);
IF CHANTTYO>-1 THEN CLOSO(CHANTTYO);
ifc dup_file thenc
IF WANT_DUP_FILE AND (NUM_OF_ERRORS_MODIFIED>0)
THEN IF ASK_WANT_DUP_FILE THEN CLOSO(CHANNEW);
endc
RUNTIME←___TIME - RUNTIME;
OUTSTR(CRLF & "PARSING TIME = "&CVS(RUNTIME)& " MSECS");
IF NUM_OF_ERRORS > 0 THEN
α
OUTSTR(crlf & "Number of errors found = "& cvs(NUM_OF_ERRORS));
OUTSTR(CRLF & "Number of errors modified = "& cvs(NUM_OF_ERRORS_MODIFIED));
β;
β "execution";
! SWAP TO AL COMPILER;
α "swap" integer array swap[0:10]; string s; integer tmperr;
if length(file:ext[BIN_file])=0 then file:ext[BIN_file] ← "BIN";
s ← make_file_name(BIN_file) & "," & make_file_name(ALL_file) & "←" & outfile;
α "switches_for_ALC" boolean seen_one; integer i;
seen_one ← false;
for i ← 0 step 1 until switch_max do
if switch_setting[i] then
α
if ¬seen_one then α s ← s & "("; seen_one ← true β;
s ← s & switch_name[i];
β;
if ¬equ(switch_name[switch_max+1],NULL) then
if seen_one then s←s&switch_name[switch_max+1]
else s←s& "(" &switch_name[switch_max+1];
if seen_one then s ← s & ")";
β "switches_for_ALC";
! if switch_setting[N_X] then tmpout("ALCNEW", s, tmperr) else tmpout("ALC", s, tmperr);
tmpout("ALC", s, tmperr);
if tmperr then usererr(0, 1, "Trouble with TMPOUT");
outstr(crlf);
swap[0] ← cvsix("DSK");
if switch_setting[N_X]
then swap[1] ← cvfil("ALCNEW.DMP[AL,HE]", swap[2], swap[4])
else swap[1] ← cvfil("ALC.DMP[AL,HE]", swap[2], swap[4]);
swap[3] ← 1; ! start job in RPG mode; swap[5] ← 0;
call(location(swap[0]), "SWAP");
β "swap";
IFC FALSE THENC
β "hidden_parse";
HIDDEN_PARSE;
ENDC
END "PARSE";